1Da: Cross-Selling in Banking
Studiengang Data Science (HS 2021), Fachhochschule Nordwestschweiz, Hochschule für Technik
Alessia Vannini
28.01.2022
library(rmarkdown)
library(tidyverse)
library(tidymodels)
library(ggmosaic)
library(ggalluvial)
library(rpart)
library(rpart.plot)
library(gridExtra)
library(usethis)
library(ggplot2)
library(dplyr)
library(lubridate)
library(eeptools)
library(data.table)
library(ggpubr)
library(rattle)
library(rsample)
library(RColorBrewer)1 Einleitung
1.1 Aufgabenstellung (Grundlage: Space “ced1 - Cross-Selling in Banking”)
Eine tschechische Bank möchte ihre Dienstleistungen für Privatkunden verbessern und “interessante Kundengruppen” identifizieren. Dabei ist für den Kunden vorallem interessant, welche Kunden “gut” und welche “schlecht” sind. Die Geschäftsleitung hat keine präzise Vorstellung, möchte aber zusätzliches Business generieren ohne unnötige Risiken einzugehen und Verluste einzufahren.
Die Bank denkt, dass mit Hilfe von Data Science, Informationen aus dem bestehenden Kundenstamm herausgeschält werden können und liefert einen Datenextrakt aus der zentralen Datenbank. Dieser enthält Informationen zu Kunden, Produktbesitz und -nutzung (z.B. Kreditvolumen, Zahlungen, Daueraufträge und Kreditkarten), Filialnetz sowie soziodemographische Informationen.
Die Vereinbarung mit dem Auftraggeber sieht vor, Konzept und Zeitplan der Analysen bis am 8. Oktober 2021 zusammenzutragen, abschliessende Resultate in Form eines Berichtes mit Analysen und Codes strukturiert und dokumentiert als R-Notebook für die weitere Verwendung innerhalb der Bank zu Verfügung zu stellen.
1.2 Ziel (Grundlage: Space “ced1 - Cross-Selling in Banking”)
Der analytische Auftrag besteht darin, Qualität und Repräsentativität der Daten zu überprüfen, die Verteilung der einzelnen Datenattribute zu erheben, deren Veränderung über die Zeit zu analysieren, Korrelationen zwischen verschiedenen Datenattributen zu quantifizieren und zu visualisieren sowie Hypothesen hinsichtlich optimaler Produktverkauf/-nutzung zu erstellen.
Im Hinblick auf ein Folgeprojekt soll ein Client Analytical Record aufbereitet werden. Mit Erzeugung des Client Analytical Records jedes individuellen Kunden, soll ein konsolidierten Datensatz bereitgestellt werden, der pro Kunde alle relevanten Informationen enthält.
1.3 Datensatz PKDD’99 Discovery Challenge
Die CSV-Dateien der einzelnen Tabellen ist öffentlich verfügbar unter https://sorry.vse.cz/~berka/challenge/PAST/index.html. Dazu gibt es eine detaillierte Beschreibung auf Englisch.
1.3.1 Sprache
Ist in diesem Bericht die gendergerechte Sprache nicht eingehalten, bezieht sich die gewählte männliche Form immer zugleich auf weibliche und männliche Personen.
Attribute und Werte sind teilweise abgekürzt und in englischer und tschechischer Sprache.
Tabellen werden teilweise in deutscher oder englischer Sprache referenziert, je nach Kontext. Für die Tabellen gilt folgende Zuordnung: - account: Konto - card: Karte - client: Kunde - disp -> disposition: Verfügungsberechtigung - district: Bezirk - loan: Kredit - order: Dauerauftrag - trans -> transaction: Transaktion/Zahlung
Tschechische Namen und Abkürzungen der Werte sind auf Englisch übersetzt.
account <- read.csv('./account.csv', sep = ";")
card <- read.csv('./card.csv', sep = ";")
client <- read.csv('./client.csv', sep = ";")
disp <- read.csv('./disp.csv', sep = ";")
district <- read.csv('./district.csv', sep = ';')
loan <- read.csv('./loan.csv', sep = ";")
order <- read.csv('./order.csv', sep = ";")
trans <- fread('./trans.csv', sep = ";")1.3.2 Unterschied read.csv, fread
Die Methoden read.csv() und fread() benötigen signifikant unterschiedlich viel Zeit für das Einlesen der Datei “trans.csv”. Fread() sind sogenannte ‘function calls’, geschrieben in der Programmiersprache C, während read ‘system calls’ sind z.B. in Bash geschrieben. Mit der Programmiersprache C lassen sich Speicherallokationen viel besser optimieren, indem nur diejenigen Bytes reserviert werden, die auch tatsächlich benötigt werden.
Treten beim Einlesen Fehler auf, kann es mit fread() vorkommen, dass der blockierte Speicher nicht freigegeben wird. In der Programmiersprache C gibt es keinen garbage collector, der Speicher wird von Hand verwaltet. Je nachdem wie der Speicher des Computers bereits ausgelastet ist, erhöht sich die Zeit mit read.csv() realtiv schnell, während die benötigte Zeit von fread() stabiler ist.
Diese Tabelle zeigt die fürs Einlesen benötigte Zeit der Date “trans.csv”.
read.timing <- system.time(read.csv('./trans.csv', sep = ";"))
data.table.timing <- system.time(allData <- fread('./trans.csv', sep = ";", showProgress = FALSE))
data <- data.frame(Methode = c('read_csv', 'fread'),
Zeit = c(read.timing[3], data.table.timing[3]))
data1.3.3 Aufbereitung der Daten
min_date <- ymd('1993-01-01')
min_year <- 1993
max_date <- ymd('1998-12-31')
max_year <- 1998Zu Beginn werden die eingelesenen Daten aufbereitet.
account <- account %>%
rename(
account_date = date
) %>%
mutate(
account_date = ymd(account_date),
frequency = case_when(
frequency == 'POPLATEK MESICNE' ~ 'monthly issuance',
frequency == 'POPLATEK TYDNE' ~ 'weekly issuance',
frequency == 'POPLATEK PO OBRATU' ~ 'issuance after transaction'
),
frequency = as.factor(frequency),
district_id = as.factor(district_id)
)card$issued <- substr(card$issued, 1, 7)
card <- card %>%
rename(
card_type = type
) %>%
mutate(
issued_date = ymd(issued)
) %>%
select(-issued)client <- client %>%
mutate(
month = substr(birth_number, 3, 4),
gender = ifelse(month > 12, 'female', 'male'),
birth_number = as.double(birth_number),
birth_number = case_when(
month > 12 ~ birth_number - 5000,
TRUE ~ birth_number
),
year = substr(birth_number, 1, 2),
birth_date = case_when(
year < 98 ~ format(ymd(birth_number), "19%y/%m/%d"),
TRUE ~ format(ymd(birth_number), "18%y/%m/%d")
),
birth_date = ymd(birth_date),
age = floor(age_calc(birth_date, max_date, units = "years")),
gender = as.factor(gender),
district_id = as.factor(district_id)
) %>%
select(-birth_number, -month, -year)disp <- disp %>%
rename(
disp_type = type
) %>%
mutate(
disp_type = ifelse(disp_type == 'OWNER', 'owner', 'disponent'),
disp_type = as.factor(disp_type)
)
disp_account_type <- disp %>%
group_by(account_id) %>%
count() %>%
ungroup %>%
mutate(
account_type = ifelse(n == 2, 'shared account', 'single account')
)
disp <- disp %>%
left_join(disp_account_type, by = 'account_id') %>%
select(-n)names(district) <- c('district_id', 'district', 'region', 'inhabitants', 'municipalities<499',
'municipalities500-1000', 'municipalities2000-9999', 'municipalities>10000', 'cities',
'ratio_urban_inhabitants', 'average_salary', 'unemployment_rate_1995', 'unemployment_rate_1996',
'enterpreneurs_per_1000', 'crimes_1995', 'crimes_1996')
district <- district %>%
mutate(
district_id = as.factor(district_id),
district = as.factor(district),
region = as.factor(region),
unemployment_rate_1995 = as.double(unemployment_rate_1995),
crimes_1995 = as.integer(crimes_1995)
)loan <- loan %>%
rename(
loan_date = date,
loan_amount = amount
) %>%
mutate(
loan_date = ymd(loan_date),
status = case_when(
status == 'A' ~ 'no problems',
status == 'B' ~ 'loan not payed',
status == 'C' ~ 'OK so far',
status == 'D' ~ 'client in debt',
TRUE ~ 'no information'
),
status = as.factor(status)
)order <- order %>%
rename(
order_character = k_symbol,
order_amount = amount,
order_bank_to = bank_to
) %>%
mutate(
order_bank_to = as.factor(order_bank_to),
order_character = case_when(
order_character == 'POJISTNE' ~ 'insurrance payment',
order_character == 'SIPO' ~ 'household',
order_character == 'LEASING' ~ 'leasing',
order_character == 'UVER' ~ 'loan payment',
TRUE ~ 'not known'
),
order_character = as.factor(order_character)
)trans <- trans %>%
rename(
trans_character = k_symbol,
trans_date = date,
trans_type = type,
trans_amount = amount
) %>%
mutate(
trans_date = ymd(trans_date),
trans_type = case_when(
trans_type == 'PRIJEM' ~ 'credit',
trans_type == 'VYDAJ' ~ 'withdrawal',
trans_type == 'VYBER' ~ 'withdrawal',
TRUE ~ 'not known'
),
trans_type = as.factor(trans_type),
operation = case_when(
operation == 'VYBER KARTOU' ~ 'credit card withdrawal',
operation == 'VKLAD' ~ 'credit in cash',
operation == 'PREVOD Z UCTU' ~ 'collection from other bank',
operation == 'VYBER' ~ 'withdrawal in cash',
operation == 'PREVOD NA UCET' ~ 'remittance to other bank',
TRUE ~ 'not known'
),
operation = as.factor(operation),
trans_character = case_when(
trans_character == 'POJISTNE' ~ 'insurrance payment',
trans_character == 'SLUZBY' ~ 'payment for statement',
trans_character == 'UROK' ~ 'interest credited',
trans_character == 'SIPO' ~ 'household',
trans_character == 'DUCHOD' ~ 'old-age pension',
trans_character == 'UVER' ~ 'loan payment',
TRUE ~ 'not known'
),
bank = as.factor(bank),
trans_character = as.factor(trans_character)
) 1.3.4 Datenmodell (kurze Erklärung der Bereinigungen der einzelnen Tabellen (account, Disposition, client, District, Trans, card, loan, Order)
Aus der Analyse der Daten lässt sich ein logistisches Datenmodell für eine Implementation in R, ableiten. Es handelt sich explizit weder um ein UML noch um ein ER-Diagramm, sondern soll die Relationen einzelner Tabellen visualisieren. Die Anzahl Ausprägungen bei einer faktorisierten Ausprägung ist in Klammer angegeben.
Die Beziehungen sind abgeleitet aus der Analyse des Datensatzes. Zu jeder eingelesenen Datei (Tabelle) sind die Attribute in einer Tabelle beschrieben. Dabei ist unterteilt nach Variablenname, Kategorisierung (quantitativ oder qualitativ), Einteilung der Skala und einer kurzen Beschreibung.
Obwohl es sich bei den ID-Attributen um numerische Werte handelt, sind diese ordinal skaliert und nicht quantitativ. Als Hilfestellung für die Einteilung, dient die Überlegung, ob es Sinn macht, dass ein Wert “doppelt so hoch” ist. Beispiel zum Attribut “account_id”: Die Aussage “Das Konto mit der ID 80 ist doppelt so hoch, wie das mit der ID 40”, ist nicht sinnvoll. Hingegen macht folgende Aussage Sinn “Der Kunde X (80 Jahre alt) ist doppelt so alt wie der Kunde Y (40 Jahre alt)”. Beim Datum ist es ähnlich. Dieses lässt sich zwar sortieren und damit in eine Reihenfolge bringen, es kann damit aber nicht gerechnet werden. Eine Rechnung müsste mit z.B. Anzahl Tagen ab einem Stichdatum erfolgen.
Auffälligkeiten einzelner Tabellen sind bei den folgenden Unterkapiteln erwähnt.
Logisches Datenmodell zum Datensatz PKDD’99 Discovery Challenge
1.3.4.1 Konto (account)
Die Tabelle account beinhaltet 4500 Observationen. Die Attribute beschreiben Eigenschaften eines Kontos. Obwohl es sich bei den den ID-Attributen um numerische Werte handelt, sind diese ordinal skaliert.
| Variable | Kategorisierung | Skala | Beschreibung |
|---|---|---|---|
| account_id | qualitativ | ordinal | Eindeutige Identifikation des Kontos |
| district_id | qualitativ | ordinal | Eindeutige Identifikation der Niederlassung an dem das Konto eröffnet wurde |
| frequency | qualitativ | nominal | Häufigkeit der Ausstellung von Bankbelegen (weekly, monthly, after transaction) |
| account_date | qualitativ | ordinal | Datum der Kontoeröffnung |
1.3.4.2 Verfügungsberechtigung (disp, disposition)
Die Tabelle disposition beinhaltet 5369 Observationen. Die Attriute beschreiben die Verfügungsberechtigung eines Kontos mit einer Beziehung zu den verbundenen Kunden. Es gibt Eigentümer (owner) und Verfügungsberechtigte (disponent). Aus einer späteren Analyse geht hervor, dass eine oder auch zwei Personen gemeinsam ein Konto führen können.
| Variable | Kategorisierung | Skala | Beschreibung |
|---|---|---|---|
| disp_id | qualitativ | ordinal | Eindeutige Identifikation des Verfügungsberechtigten |
| client_id | qualitativ | ordinal | Eindeutige Identifikation des Kunden |
| account_id | qualitativ | ordinal | Eindeutige Identifikation des Kontos |
| disp_type | qualitativ | nominal | Unterscheidung zwischen Eigentümer (owner) und Verfügungsberechtigter (disponent) über ein Konto |
1.3.4.3 Kunde (client)
Die Tabelle client beinhaltet 5369 Observationen. Die Attribute beschreiben einen Kunden.
| Variable | Kategorisierung | Skala | Beschreibung |
|---|---|---|---|
| client_id | qualitativ | ordinal | Eindeutige Identifikation des Kunden |
| district_id | qualitativ | ordinal | Eindeutige Identifikation der Niederlassung an dem das Konto eröffnet wurde |
| gender | qualitativ | nominal | Unterscheidung des Geschlechts |
| birth_date | qualitativ | ordinal | Geburtsdatum des Kunden |
| age | quantitativ | metrisch | Alter des Kunden |
1.3.4.4 Karte (card)
Die Tabelle card beinhaltet 892 Observationen. Die Attribute beschreiben verschiedene Kartentypen und die Verbindung zur Tabelle disposition. Ein Kunde hat maximal eine Karte. Dies ist anhand der Duplikatsfilterung auf das Referenzattribut zur Tabelle disposition ersichtlich. Pro Konto hat maximal eine Person, also ein Kunde, eine Karte. Das ist jeweils der Eigentümer (owner) des Kontos.
| Variable | Kategorisierung | Skala | Beschreibung |
|---|---|---|---|
| card_id | qualitativ | ordinal | Eindeutige Identifikation der Karte |
| disp_id | qualitativ | ordinal | Eindeutige Identifikation des Verfügungsberechtigten |
| card_type | qualitativ | nominal | Kartentyp (gold, classic, junior) |
| issued_date | qualitativ | ordinal | Datum der Kartenausstellung |
nrow(card)## [1] 892card[!duplicated(card$disp_id,fromLast=TRUE),]1.3.4.5 Kredit (loan)
Die Tabelle loan beinhaltet 682 Observationen. Die Attribute beschreiben Kredite und die Verbindung zur Tabelle account. Ein Konto hat maximal einen Kredit. Dies ist anhand der Duplikatsfilterung auf das Referenzattribut zur Tabelle account ersichtlich. Die Verbindung zur Tabelle account schliesst - bei gemeinsam geführten Konten - die Analyse aus, welchem Kunden der Kredit zugeordnet ist.
In der Schweiz gilt gemäss Gesetz, wenn ein Ehepartner einen Kredit aufnimmt, die Solidarschuld des anderen Ehepartners. Die Zuordnung zum Kunden ist deshalb nicht relevant.
| Variable | Kategorisierung | Skala | Beschreibung |
|---|---|---|---|
| loan_id | qualitativ | ordinal | Eindeutige Identifikation des Kredits |
| account_id | qualitativ | ordinal | Eindeutige Identifikation des Kontos |
| loan_date | qualitativ | ordinal | Datum der Kreditausstellung |
| amount | quantitativ | metrisch | Höhe des Kredits |
| duration | quantitativ | metrisch | Länge des Kredits in Monaten (12, 24, 36, 48, 60) |
| payments | quantitativ | metrisch | Monatliche Rückzahlungen |
| status | qualitativ | nominal | Status des Kredits (no problems, OK so far, loan not payed, in debt) |
nrow(loan)## [1] 682loan[!duplicated(loan$account_id,fromLast=TRUE),]1.3.4.6 Dauerauftrag (order)
Die Tabelle order beinhaltet 6471 Observationen. Die Attribute beschreiben Daueraufträge und die Verbindung zur Tabelle account. Es gibt Konten mit mehr als einem Dauerauftrag. Dies ist anhand der Duplikatsfilterung auf das Referenzattribut zur Tabelle account ersichtlich.
| Variable | Kategorisierung | Skala | Beschreibung |
|---|---|---|---|
| loan_id | qualitativ | ordinal | Eindeutige Identifikation des Kredits |
| account_id | qualitativ | ordinal | Eindeutige Identifikation des Kontos |
| loan_date | qualitativ | ordinal | Datum der Kreditausstellung |
| amount | quantitativ | metrisch | Höhe des Kredits |
| duration | quantitativ | metrisch | Länge des Kredits in Monaten (12, 24, 36, 48, 60) |
| payments | quantitativ | metrisch | Monatliche Zinsen |
| status | qualitativ | nominal | Status des Kredits (no problems, OK so far, loan not payed, in debt) |
nrow(order)## [1] 6471order[!duplicated(order$account_id,fromLast=TRUE),]1.3.4.7 Zahlung (trans)
Die Tabelle trans ist die grösste Tabelle und beinhaltet 1056320 Observationen. Die Attribute beschreiben Zahlungen und die Verbindung zur Tabelle account. Auch hier ist keine Analyse möglich, ob Eigentümer oder Verfügungsberechtigter eine Zahlung getätigt haben. Es sind mehrere Transaktionen pro Konto möglich.
Im ursprünglichen Datensatz wird nicht nur zwischen Gutschrift (credit) und Belastung (withdrawal) unterschieden, sondern es gibt auch eine Zahlungstyp ‘Belastung in bar’. In der Aufbereitung dieser Tabelle wurde dieser dritte Zahlungstyp mit dem Typ ‘Belastung’ (withdrawal) zusammengefasst.
| Variable | Kategorisierung | Skala | Beschreibung |
|---|---|---|---|
| trans_id | qualitativ | ordinal | Eindeutige Identifikation der Transaktion |
| account_id | qualitativ | ordinal | Eindeutige Identifikation des Kontos |
| trans_date | qualitativ | ordinal | Datum der Transaktion |
| trans_type | qualitativ | nominal | Unterscheidung Gutschrift (credit) und Belastung (withdrawal) |
| operation | qualitativ | nominal | Fünf verschiedene Transaktionsmodus: credit card withdrawal, credit in cash, collection from another bank, withdrawal in cash, remittance to another bank |
| amount | quantitativ | metrisch | Höhe der Transaktion |
| balance | quantitativ | metrisch | Kontostand nach der Transaktion |
| trans_character | qualitativ | nominal | Sechs verschiedene Transaktionsgründe: insurrance payment, payment for statement, interest credited, sanction interest if negative balance, household, old-age pension, loan payment |
| bank | qualitativ | nominal | Bank des Transaktionspartners |
| account | qualitativ | ordinal | Konto des Transaktionspartners |
1.3.4.8 Bezirk (district)
Die Tabelle district beinhaltet 77 Observationen. Die Attribute beschreiben 77 Bezirke von Tschechien sowie beinhaltet Verbindungen zu den Tabellen account und client. Jedes Konto referenziert den Bezirk einer Bankfiliale sowie den Wohnort eines Kunden. Beim Bezirk Jesenik sind im ursprünglichen Datensatz in den Spalten A12 (umbenannt: unemployment_rate_1995) und A15 (umbenannt: crimes_1995) zwei “?” enthalten. Dies führt beim Aufbereiten zu je einem NA Wert.
| Variable | Kategorisierung | Skala | Beschreibung |
|---|---|---|---|
| district_id | qualitativ | ordinal | Eindeutige Identifikation des Distrikts |
| district | qualitativ | nominal | Name des Distrikts (77 verschiedene) |
| region | qualitativ | nominal | Name der Region (8 verschiedene) |
| inhabitants | quantitativ | metrisch | Anzahl Einwohner |
| municipalities<499 | quantitativ | metrisch | Anzahl Gemeinden mit weniger als 499 Einwohner |
| municipalities500-1000 | quantitativ | metrisch | Anzahl Gemeinden mit 500-100 Einwohner |
| municipalities2000-9999 | quantitativ | metrisch | Anzahl Gemeinden mit 2000-9999 Einwohner |
| municipalities>10000 | quantitativ | metrisch | Anzahl Gemeinden mit mehr als 10000 Einwohner |
| cities | quantitativ | metrisch | Anzahl Städte |
| ratio_urban_inhabitants | quantitativ | metrisch | Verhältnis Einwohner Land-Stadt |
| average_salary | quantitativ | metrisch | Durchschnittslohn |
| unemployment_rate_1995 | quantitativ | metrisch | Arbeitslosenrate im Jahr 1995 |
| unemployment_rate_1996 | quantitativ | metrisch | Arbeitslosenrate im Jahr 1996 |
| entrepreneurs_per_1000 | quantitativ | metrisch | Unternehmer (pro 1000 Einwohner) |
| crimes_1995 | quantitativ | metrisch | Kriminalfälle im Jahr 1995 |
| crimes_1996 | quantitativ | metrisch | Kriminalfälle im Jahr 1996 |
1.3.5 Auffälligkeiten
In den Tabellen card, loan und trans sind Daten vom 01.01.1993 bis zum 31.12.1998 vorhanden, während in der Tabelle account Daten nur bis zum 31.12.1997 vorhanden sind. Möglicherweise handelt es sich um ein Versehen beim Datenexport aus der zentralen Datenbank.
In der Originalbeschreibung des Datensatzen auf der Webseite steht, dass ein Kunde mehrere Konten haben kann. Im extrahierten Datensatz hat jeder Kunde - teilweise mit einem anderen Kunden zusammen - nur ein Konto. Ist die Originalbeschreibung in diesem Punkt falsch und die Abbildung des Datensatzes entspricht der Realtität, könnte die Verbindungstabelle disp zwischen den Tabellen account und client aufgehoben werden. Das Attribut disp_type, welches die Verfügungsberechtigung regelt, würde zur client Tabelle hinzugefügt. Die card Tabelle müsste mit der account Tabelle über die account_id (anstatt jetzt disp_id) verbunden werden.
Laut Originalbeschreibung können Kunden auch mehrere Kreditkarten pro Konto haben. Im vorliegenden Datensatz hat jedoch jedes Konto maximal eine Kreditkarte.
Attribute, die ein Datum wiedergeben, sind im ursprünglichen Datensatz als Strings vorhanden. Es ist nicht wie anzunehmen ein Zeitstempel, der beim Eintrag in die Datenbank automatisch generiert wird. Dies erschwert die Sortierung massiv. Werden von einem Konto mehrere Transaktionen pro Tag getätigt, ist es nur anhand der account_id sowie des Transaktionsdatums unmöglich zu eruieren, welches die letzte Transaktion, respektive der letzte Kontostand des Tages ist. Naheliegend ist die Vermutung, dass die ID’s der Transaktionen aufsteigend sind.
trans %>% filter(trans_id == 203 | trans_id == 159 | trans_id == 3530442) %>%
arrange(trans_date)Dieses Beispiel zeigt, dass dies nicht so ist. Der aktuelle Kontostand (balance) wird aus dem Kontostand des letzten Datums plus des Transaktionstyps (Gutschrift/Belastung) sowie des Transaktionsbetrages errechnet. In diesem Fall käme nach der Transaktion am 21.08.1995 die Transaktion mit der ID 3530442. Die Transaktion mit der ID 159 wäre die letzte.
trans %>% filter(trans_id == 203 | trans_id == 159 | trans_id == 3530442) %>%
arrange(desc(trans_amount))In der Tabelle disp sind die Attribute disp_id und client_id bis zur Nummer 8777 identisch. Das ist insofern erklärbar, alsdass ein Kunde zum Zeitpunkt bei der Bank registriert wird, in dem er eine Geschäftsbeziehung eingeht.
Die ID’s sind nicht fortfolgend. Eine Möglichkeit ist, dass es sich bei den fehlenden ID’s um Kunden handelt, die zum Zeitpunkt des Exports keine Geschäftsbeziehungen mehr mit der Bank haben. Dagegen spricht, dass es in der Tabelle account kein Attribut für eine Kontoschliessung gibt. Es wäre auch möglich, wobei eher unvorstellbar, dass die Observationen von Kunden mit terminierten Geschäftsbeziehungen ganz aus den Daten gelöscht wurden. Eine andere Möglichkeit ist, dass beim Datenexport nur eine Zufallsauswahl der Daten exportiert wurde. Gemäss Analysen im Kapitel wurden im ersten Jahr 1578 neue Konten eröffnet. In den vier Folgejahren je ca. 1000. Das scheint eher wenig und spricht für diese Möglichkeit.
Für die weitere Analyse der Daten werden die Tabellen gemäss oben visualisierten Datenmodell verbunden.
df_account_disp <- left_join(account, disp, by = 'account_id')
df_account_disp_client <- left_join(df_account_disp, client, by = 'client_id') %>%
select(-birth_date) %>%
rename(
district_account = district_id.x,
district_client = district_id.y
) %>%
mutate(
age_grouped = case_when(
age <= 26 ~ '11-26',
age <= 41 ~ '27-41',
age <= 56 ~ '42-56',
age <= 71 ~ '57-71',
age <= 87 ~ '72-87',
TRUE ~ 'not known'
),
age_grouped = as_factor(age_grouped),
age_grouped_desc = fct_reorder(age_grouped, desc(age_grouped))
)
df_account_disp_client$age_grouped <-
ordered(df_account_disp_client$age_grouped, levels = c('11-26', '27-41', '42-56', '57-71', '72-87'))df_trans_account_client_disp <- left_join(trans, df_account_disp_client, by = "account_id") %>%
select(-client_id, -bank, -account)df_order_all <- full_join(order, df_account_disp_client, by = "account_id") %>%
select(-order_id, -disp_id, -district_account, -account_to, -client_id, -frequency, -age_grouped, -age_grouped_desc) %>%
mutate(
order = ifelse(is.na(order_character), 'no', 'yes'),
order = as_factor(order)
) %>%
filter(disp_type == 'owner')df_trans_order_all <- left_join(trans, df_order_all, by = 'account_id') %>%
select(-trans_id, -bank, -account) %>% distinct()df_loan_all <- full_join(loan, df_account_disp_client, by = "account_id") %>%
select(-loan_id, -disp_id, -age_grouped, -age_grouped_desc, -frequency, -district_account) %>%
mutate(
loan = ifelse(is.na(loan_date), 'no', 'yes'),
loan = as_factor(loan),
end_date = add_with_rollback(loan_date, months(duration), roll_to_first = TRUE),
loan_diff_time = interval(loan_date, account_date) / years(1),
loan_diff_time_loanstatus = interval(end_date, max_date) / years(1),
loan_status = ifelse(end_date > '1998-12-31', 'active', 'finished'),
duration = as.factor(duration)
) %>%
filter(disp_type == 'owner')
df_loan_all$status <- ordered(df_loan_all$status, levels = c('client in debt', 'OK so far', 'loan not payed', 'no problems'))df_trans_loan_all <- left_join(trans, df_loan_all, by = 'account_id') %>%
select(-trans_id, -bank, -account)df_card_all <- full_join(card, df_account_disp_client, by = "disp_id") %>%
select(-disp_id, -frequency, -age_grouped, -age_grouped_desc, -card_id, -district_account) %>%
mutate(
card_type = case_when(
card_type == 'gold' ~ 'gold',
card_type == 'classic' ~ 'classic',
card_type == 'junior' ~ 'junior',
TRUE ~ 'no card'),
card_type = as.factor(card_type),
card = ifelse(card_type == 'no card', 'no', 'yes'),
card = as_factor(card),
card_diff_time = interval(issued_date, account_date) / years(1)
) %>%
filter(disp_type == 'owner')
df_card_all$card_type <-
ordered(df_card_all$card_type, levels = c('no card', 'junior', 'classic', 'gold'))df_trans_card_all <- left_join(trans, df_card_all, by = 'account_id') %>%
select(-bank, -account)df_order_help <- df_order_all %>%
select(account_id, order) %>%
distinct()
df_products_all <- df_card_all %>%
left_join(df_loan_all, by = 'account_id') %>%
mutate(
loan = ifelse(is.na(loan_date), 'no', 'yes'),
loan = as_factor(loan),
) %>%
select(-account_date.x, -client_id.x, -disp_type.x, -account_type.x, -district_client.x, -gender.x, -age.x ) %>%
rename(
account_date = account_date.y,
client_id = client_id.y,
disp_type = disp_type.y,
account_type = account_type.y,
district_client = district_client.y,
gender = gender.y,
age = age.y
) %>%
left_join(df_order_help, by = 'account_id') %>%
relocate(
account_id, account_date, account_type, client_id, gender, age, district_client, order, loan, loan_date, loan_amount,
duration, payments, status, card, issued_date, card_type) %>%
mutate(
product = ifelse(order == 'yes' | loan == 'yes' | card == 'yes', 'yes', 'no'),
product_type = case_when(
card == 'yes' & order == 'no' & loan == 'no' ~ 'card',
card == 'no' & order == 'yes' & loan == 'no' ~ 'order',
card == 'no' & order == 'no' & loan == 'yes' ~ 'loan',
card == 'yes' & order == 'yes' & loan == 'no' ~ 'card, order',
card == 'no' & order == 'yes' & loan == 'yes' ~ 'loan, order',
card == 'yes' & order == 'no' & loan == 'yes' & issued_date <= loan_date ~ 'card, loan',
card == 'yes' & order == 'no' & loan == 'yes' & issued_date >= loan_date ~ 'loan, card',
card == 'yes' & order == 'yes' & loan == 'yes' & issued_date <= loan_date ~ 'card, loan, order',
card == 'yes' & order == 'yes' & loan == 'yes' & issued_date >= loan_date ~ 'loan, card, order',
TRUE ~ 'no product'
)
)
df_products_all$product_type <-
ordered(df_products_all$product_type, levels = c('card', 'loan', 'order', 'card, loan', 'card, order', 'loan, order', 'card, loan, order', 'loan, card, order','no product'))a <- df_products_all %>%
select(account_id, product_type, card, issued_date, loan, loan_date, order) %>%
filter(product_type == 'loan, card, order')df_district_products_all <- merge(x = df_products_all, y = district, by.x='district_client', by.y='district_id') %>%
relocate(district_client, .after = client_id)df_trans_products_all <- df_products_all %>%
left_join(trans, by = "account_id") %>%
distinct() %>%
select(-trans_id, -bank, -account)df_district_trans_products_all <- merge(x = df_trans_products_all, y = district, by.x='district_client', by.y='district_id') %>% relocate(district_client, .after = client_id)2 Erste Analysen über alle Kunden
2.1 Entwicklung Anzahl Konten
Für die Analyse der Entwicklung der Anzahl Konten werden Daten aus den Tabellen account, disp und client verwendet. Der Zeitraum dieser Daten ist 01.01.1993 - 31.12.1997.
df_dev_accounts <- df_account_disp_client %>%
filter(disp_type == 'owner') %>%
group_by(account_date, gender, age_grouped) %>%
count(account_date) %>%
ungroup() %>%
mutate(
added_n = cumsum(n),
year = year(account_date),
year = as_factor(year)
)
df_dev_accounts %>% ggplot(aes(x = account_date)) +
geom_histogram(bins = 60) +
labs(title = 'Anzahl neuer Konten pro Monat',
subtitle = paste0("Anzahl Observationen = ", nrow(account)),
x = 'Zeit',
y = 'Anzahl Konten'
)
Die Abbildung zeigt, dass im Jahr 1993 und 1996 deutlich mehr Konten eröffnet wurden, als 1994, 1995 und auch 1996. Tschechien erlebte von 1996 - 2000 eine Wirtschaftskrise. Zwischen 1994 und 1997 stieg die Anzahl Konten pro Monat im Trend linear. Aus dem Anstieg der Kontoeröffnungen im 1996, also zu Beginn der Wirtschaftskrise, kann eine verspätete Reaktion auf Wirtschaftsereignisse abgeleitet werden.
Die totale Anzahl Konten pro Tag über den Zeitraum steigt indessen realtiv linear. Eine Abflachung ist zwischen Anfang 1994 und Ende 1995 erkennbar, viel weniger als die obige Abbildung es aber vermuten liess.
Weil für die Analyse nur ein Datenexkrakt zur Verfügung steht, ist es einfach erklärbar, dass zu Beginn des Zeitraums noch keine Konten vorhanden sind. Überraschend hingegen ist der Fakt, dass der Datenzeitraum am 01.01.1993 beginnt, am gleichen Tag als die Tschechiche Republik entstand.
df_dev_accounts %>% ggplot(aes(x = account_date, y = added_n)) + geom_line(size = 1, color = 'gray37') +
labs(title = 'Entwicklung aller Konten pro Tag',
subtitle = paste0("Anzahl Observationen = ", nrow(account)),
x = 'Zeit',
y = 'Total Konten'
)
Die Verteilung neuer Konten pro Tag ist unabhängig von Geschlecht und Alter der Kunden, wie nachfolgende Abbildungen visualisieren.
df_dev_accounts %>% ggplot(aes(x = year)) + geom_bar() + facet_wrap(~ gender) +
geom_text(aes(label = ..count..), stat = "count", position = position_stack(vjust = 0.5), color = 'white') +
labs(title = 'Anzahl neuer Konten pro Tag',
subtitle = paste0("Anzahl Observationen = ", nrow(account)),
x = 'Zeit',
y = 'Anzahl Konten'
)
df_dev_accounts %>% ggplot(aes(x = account_date)) + geom_density() + facet_wrap(~ age_grouped) +
labs(title = 'Anzahl neuer Konten pro Tag',
subtitle = paste0("Anzahl Observationen = ", nrow(account)),
x = 'Zeit',
y = 'Anzahl Konten'
)
2.2 Entwicklung Vermögen der Bank
Für die Analyse der Entwicklung der Anzahl Konten werden Daten aus der Tabelle trans verwendet. Der Zeitraum dieser Daten ist 01.01.1993 - 31.12.1998. Grundlage für die Analyse bildet der letzte Kontostand aller Ende des Jahres vorhandenen Konten. Aufgrund der bereits beschriebenen Schwierigkeit der Sortierung bei Konten mit mehreren Transaktionen pro Tag, sind die Zahlen nur näherungsweise korrekt.
df_19931231 <- trans %>%
filter(trans_date <= '1993-12-31') %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup()
df_19941231 <- trans %>%
filter(trans_date <= '1994-12-31') %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup()
df_19951231 <- trans %>%
filter(trans_date <= '1995-12-31') %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup()
df_19961231 <- trans %>%
filter(trans_date <= '1996-12-31') %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup()
df_19971231 <- trans %>%
filter(trans_date <= '1997-12-31') %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup()
df_19981231 <- trans %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup()
print('31.12.1993')## [1] "31.12.1993"summary(df_19931231$balance)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 200 20980 29016 32393 42557 122098sum(df_19931231$balance)## [1] 36895806print('31.12.1994')## [1] "31.12.1994"summary(df_19941231$balance)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2264 23912 30728 34973 43702 105685sum(df_19941231$balance)## [1] 55186890print('31.12.1995')## [1] "31.12.1995"summary(df_19951231$balance)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -3729 22855 32211 35613 44632 115807sum(df_19951231$balance)## [1] 79736915print('31.12.1996')## [1] "31.12.1996"summary(df_19961231$balance)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -10323 21486 32030 36043 47747 120503sum(df_19961231$balance)## [1] 129826221print('31.12.1997')## [1] "31.12.1997"summary(df_19971231$balance)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -14673 22035 33161 37961 50150 124491sum(df_19971231$balance)## [1] 170825501print('31.12.1998')## [1] "31.12.1998"summary(df_19981231$balance)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -25821 23075 38495 43809 60589 138317sum(df_19981231$balance)## [1] 197141413df_1993 <- df_19931231%>%
summarise(
Min = min(balance),
First_Qu = quantile(balance, 0.25),
Median = median(balance),
Mean = mean(balance),
Third_Qu = quantile(balance, 0.75),
Max = max(balance)
) %>%
mutate(
date = ymd('1993-12-31')
)
df_1994 <- df_19941231%>%
summarise(
Min = min(balance),
First_Qu = quantile(balance, 0.25),
Median = median(balance),
Mean = mean(balance),
Third_Qu = quantile(balance, 0.75),
Max = max(balance)
) %>%
mutate(
date = ymd('1994-12-31')
)
df_1995 <- df_19951231 %>%
summarise(
Min = min(balance),
First_Qu = quantile(balance, 0.25),
Median = median(balance),
Mean = mean(balance),
Third_Qu = quantile(balance, 0.75),
Max = max(balance)
) %>%
mutate(
date = ymd('1995-12-31')
)
df_1996 <- df_19961231%>%
summarise(
Min = min(balance),
First_Qu = quantile(balance, 0.25),
Median = median(balance),
Mean = mean(balance),
Third_Qu = quantile(balance, 0.75),
Max = max(balance)
) %>%
mutate(
date = ymd('1996-12-31')
)
df_1997 <- df_19971231%>%
summarise(
Min = min(balance),
First_Qu = quantile(balance, 0.25),
Median = median(balance),
Mean = mean(balance),
Third_Qu = quantile(balance, 0.75),
Max = max(balance)
) %>%
mutate(
date = ymd('1997-12-31')
)
df_1998 <- df_19981231%>%
summarise(
Min = min(balance),
First_Qu = quantile(balance, 0.25),
Median = median(balance),
Mean = mean(balance),
Third_Qu = quantile(balance, 0.75),
Max = max(balance)
) %>%
mutate(
date = ymd('1998-12-31')
)
df_end <- bind_rows(df_1993, df_1994, df_1995, df_1996, df_1997, df_1998)
df_end %>% ggplot() +
geom_line(aes(x = date, y = Min), color = 'red', size = 1) +
geom_line(aes(x = date, y = First_Qu), color = 'gray60', size = 1) +
geom_line(aes(x = date, y = Median), color = 'deepskyblue', size = 1) +
geom_line(aes(x = date, y = Mean), color = 'blue', size = 1) +
geom_line(aes(x = date, y = Third_Qu), color = 'gray60', size = 1) +
geom_line(aes(x = date, y = Max), color = 'chartreuse4', size = 1) +
labs(title = 'Entwicklung des Vermögens der Bank',
subtitle = '01.01.1993 - 31.12.1998',
x = 'Zeit',
y = 'Vermögen in CZK'
)
Die Analyse zeigt, dass das Vermögen der Bank über den Zeitraum gestiegen ist. Während der Median per Ende 1994 noch bei 30728 CZK ist, liegt er per Ende 1998 bereits bei 38495 CZK. Dies entspricht einem Zuwachs von über 25 %. Wobei der Anstieg nicht linear ist. So sind es im ersten Jahr nur 4.8 % und bis Ende 1997 7.9 %. Der grosse Sprung von rund 17 % entsteht im Jahr 1998.
Ähnlich verhält es sich mit dem Quartielsabstand. Sind es Ende 1994 knapp 20000 CZK, so steigt der Abstand auf fast 30000 CZK per Ende 1997 und auf rund 37000 CZK per Ende 1998. Dies deutet daraufhin, dass sich das Vermögen der Kunden immer weiter streut.
Der niedrigste und höchste Kontostand bestätigen, dass sich die Schere immer weiter öffnet. Erschreckend ist auch der höchste Negativsaldo von -25821 CZK.
2.3 Geschlechterverteilung der Kunden
Für die Analyse der Anzahl Männer und Frauen werden Daten aus den Tabellen account, disp und client verwendet.
df_account_disp_client %>%
mutate(
client = ifelse(is.na(client_id), 'no', 'yes')
) %>%
ggplot(aes(x = client, fill = gender)) +
geom_bar(position = 'fill') +
coord_flip() +
labs(title = 'Kunden der Bank',
subtitle = paste0("Anzahl Observationen = ", nrow(df_account_disp_client)),
x = 'Kunde der Bank',
y = 'Kunden in Prozent',
fill = 'Geschlecht'
)
Es sind minimal mehr männliche als weibliche Kunden. In Tschechien leben mehr Frauen als Männer. 2015 waren es 3.4 % mehr Frauen als Männer. Diese Verteilung weicht aber nicht signifikant davon ab.
2.4 Altersverteilung der Kunden
Für die Analyse der Altersverteilung werden Daten aus den Tabellen account, disp und client verwendet.
mean_age <- mean(df_account_disp_client$age)
median_age <- median(df_account_disp_client$age)
df_account_disp_client %>% ggplot(aes(x = age)) +
geom_density(size = 1) +
geom_vline(xintercept = mean_age, color = 'red') +
geom_text(mapping = aes(x = mean_age, y = 0, label = "mean"), color = "red", hjust = -0.2, vjust = 1) +
geom_vline(xintercept = median_age, color = 'orange') +
geom_text(mapping = aes(x = median_age, y = 0, label = "median"), color = "orange", hjust = 1.2, vjust = 1) +
geom_vline(xintercept = 17, color = 'chartreuse3') +
geom_text(mapping = aes(x = 17, y = 0, label = "17"), color = "chartreuse3", hjust = 1.2, vjust = 1) +
geom_vline(xintercept = 59, color = 'chartreuse3') +
geom_text(mapping = aes(x = 59, y = 0, label = "59"), color = "chartreuse3", hjust = 1.2, vjust = 1) +
geom_vline(xintercept = 80, color = 'chartreuse3') +
geom_text(mapping = aes(x = 80, y = 0, label = "80"), color = "chartreuse3", hjust = 1.2, vjust = 1) +
labs(title = 'Altersverteilung der Kunden',
subtitle = paste0("Anzahl Observationen = ", nrow(df_account_disp_client)),
x = 'Alter',
y = 'Dichte'
)
#turning points in age
#in general
nr1 <- df_account_disp_client %>%
filter(age == 17) %>%
nrow()
nr2 <- df_account_disp_client %>%
filter(age == 18) %>%
nrow()
nr3 <- df_account_disp_client %>%
filter(age == 59) %>%
nrow()
nr4 <- df_account_disp_client %>%
filter(age == 60) %>%
nrow()
nr5 <- df_account_disp_client %>%
filter(age == 80) %>%
nrow()
nr6 <- df_account_disp_client %>%
filter(age == 81) %>%
nrow()
#turning points in age
#for women
df_account_disp_client_w <- df_account_disp_client %>%
filter(gender == 'female')
nrw1 <- df_account_disp_client_w %>%
filter(age == 17) %>%
nrow()
nrw2 <- df_account_disp_client_w %>%
filter(age == 18) %>%
nrow()
nrw3 <- df_account_disp_client_w %>%
filter(age == 59) %>%
nrow()
nrw4 <- df_account_disp_client_w %>%
filter(age == 60) %>%
nrow()
nrw5 <- df_account_disp_client_w %>%
filter(age == 80) %>%
nrow()
nrw6 <- df_account_disp_client_w %>%
filter(age == 81) %>%
nrow()
#for men
df_account_disp_client_m <- df_account_disp_client %>%
filter(gender == 'male')
nrm1 <- df_account_disp_client_m %>%
filter(age == 17) %>%
nrow()
nrm2 <- df_account_disp_client_m %>%
filter(age == 18) %>%
nrow()
nrm3 <- df_account_disp_client_m %>%
filter(age == 63) %>%
nrow()
nrm4 <- df_account_disp_client_m %>%
filter(age == 64) %>%
nrow()
nrm5 <- df_account_disp_client_m %>%
filter(age == 80) %>%
nrow()
nrm6 <- df_account_disp_client_m %>%
filter(age == 81) %>%
nrow()Drei Änderungen der Kurve sind signifikant: - Sprunghafter Anstieg bei jungen Kunden von 17 auf 18 Jahre - Abnahme um ca. 60 Jahre - Erneute Abnahme ab 80 Jahren
Die meisten Kunden sind zwischen 20 und 60 Jahre alt. Die Unterscheidung nach Geschlecht zeigt nur minimale Unterschiede. Bei Frauen ist die Änderung bereits bei 59 Jahren, während bei Männern die Wendung erst bei 63 geschieht. Das ist mit dem früeren Pensionsalter von Frauen erklärbar.
mean_age <- mean(df_account_disp_client$age)
median_age <- median(df_account_disp_client$age)
df_account_disp_client %>% ggplot(aes(x = age, color = gender)) +
geom_density(size = 1) +
scale_color_brewer(palette = "Paired") +
labs(title = 'Altersverteilung der Kunden',
subtitle = paste0("Anzahl Observationen = ", nrow(df_account_disp_client)),
x = 'Alter',
y = 'Dichte',
color = 'Geschlecht'
)
Eine noch detailliertere Betrachtung des Alters zeigt signifikante Unterschiede einzelner Alter. Die ältesten Kunden sind zum Beispiel zu 100 % Männer. Es ist anzunehmen, dass diese Unterschiede auf die zufällige Generierung des Datensatzes zurückzuführen ist.
df_account_disp_client %>% ggplot(aes(x = age, fill = gender)) + geom_bar(position = 'fill') +
coord_flip() + geom_hline(yintercept = 0.5, color = 'red', size = 0.75) +
scale_fill_brewer(palette = "Paired") + xlab('Age of clients') +
labs(title = 'Altersverteilung der Kunden',
subtitle = paste0("Anzahl Observationen = ", nrow(df_account_disp_client)),
x = 'Alter',
y = 'Prozent der Kunden',
fill = 'Geschlecht'
)
summary(df_account_disp_client$age)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 11.0 30.0 44.0 44.8 58.0 87.0Das “5 number summary” ergibt das niedrigste Alter von 11 Jahren.
df_account_disp_client %>% filter(account_id == 2836)Dabei handelt es sich um Konto, das von einem jungen, männlichen Erwachsenen und einem Mädchen geführt wird. Aufgrund des Altersunterschiedes ist vermutbar, dass es Geschwister sind. Unklar ist, ob es ein Minimumalter für eine Kontoeröffnung braucht. Es ist möglich, dass die Eltern das Konto auf den Namen der Kinder eröffnet haben.
2.5 Verfügungsberechtigung von Konten
Für die Analyse werden Daten aus den Tabellen account, disp und client verwendet.
df_account_type <- df_account_disp_client[!duplicated(df_account_disp_client$account_id),]
df_account_type %>% ggplot(aes(x = account_type)) + geom_bar() +
geom_text(aes(label = ..count..), stat = "count", vjust = -0.5, color = 'black') +
labs(title = 'Verteilung nach Kontotyp',
subtitle = paste0("Anzahl Observationen = ", nrow(account)),
x = 'Kontotyp',
y = 'Anzahl'
)
Aus der Tabelle disp geht hervor, dass es Konten mit einem oder mit zwei Kunden gibt. Ist mit einem Konto nur ein Kunde verbunden, ist dieser automatisch Eigentümer (owner). Bei zwei Kunden ist einer Eigentümer (owner) und der andere Verfügungsberechtigter (disponent). Insgesamt werden über 80 % der Konten von nur einer Person geführt und nur 20 %, also ca. 1/5 sind Konten mit zwei Kunden.
df_account_disp_client %>% ggplot(aes(y = age, fill = gender)) +
geom_boxplot() +
theme(axis.text.x=element_blank(), axis.ticks.x = element_blank()) +
facet_wrap( ~ disp_type) +
labs(title = 'Altersverteilung der Kunden',
subtitle = paste0("Anzahl Observationen = ", nrow(df_account_disp_client)),
x = 'Verfügungsberechtigung',
y = 'Alter',
fill = 'Geschlecht'
)
Eigentümer sind tendentiell etwas jünger als Verfügungsberechtigte. Der Geschlechtervergleich zeigt, dass die Altersverteilung bei den Eigentümern in etwa identisch ist. Weibliche Verfügungsberechtigte sind älter als männliche.
2.5.1 Gemeinsame Konten (2 Kunden)
Für die Analyse werden Daten aus den Tabellen account, disp und client verwendet. Darauf wird der Filter auf den Kontotyp “shared account” angewendet.
df_shared_accounts <- df_account_disp_client %>%
filter(
account_type == 'shared account'
)
df_shared_accounts %>% ggplot(aes(x = age, color = disp_type)) +
geom_density(size = 1) +
labs(title = 'Altersverteilung der Kunden mit gemeinsamen Konto',
subtitle = paste0("Anzahl Observationen = ", nrow(df_shared_accounts)),
x = 'Alter',
y = 'Dichte',
color = 'Verfügungsberechtigung'
)
Die Altersverteilung von Kunden, die gemeinsam ein Konto führen, gleicht ansatzmässig einer Normalverteilung.
df_shared_accounts %>%
ggplot(aes(x = age, color = gender)) +
geom_density() + facet_wrap(~ disp_type) +
labs(title = 'Altersverteilung der Kunden mit gemeinsamen Konto',
subtitle = paste0("Anzahl Observationen = ", nrow(df_shared_accounts)),
x = 'Alter',
y = 'Dichte',
color = 'Geschlecht'
)
Eine detailliertere Analyse nach Geschlecht zeigt signifikante Unterschiede. Junge Eigentümer sind häufig Frauen, ältere, Männer. Mögliche Erklärungen sind: - Bei älteren Generationen hat häufig der Mann “das Sagen” und regelt finanzielle Tätigkeiten - Bei jüngeren Generationen erledigen häufiger Frauen administrative Tätigkeiten - Frauen sind kompetent in diesen Bereichen: In der Schweiz gibt es aktuell zum Beispiel auch deutlich mehr weibliche KV-Lernende - Männer beschäftigen sich eher mit “ruhmreicheren” Aufgaben, die sichtbar sind und wofür sie dann auch Anerkennung erhalten (traditionelles Familienbild)
df_shared_accounts %>% ggplot(aes(x = gender)) + geom_bar() +
geom_text(aes(label = ..count..), stat = "count", vjust = -0.5, color = 'black') +
labs(title = 'Geschlechterverteilung der Kunden mit einem gemeinsamen Konto',
subtitle = paste0("Anzahl Observationen = ", nrow(df_shared_accounts)),
x = 'Geschlecht',
y = 'Anzahl Kunden'
)
Gemeinsame Konten werden immer von einem Mann und einer Frau geführt. Mögliche Erklärungen dafür sind eine Partnerschaft / Ehe oder Verwandschaft. Das “5 number summary” zeigt, dass zwei Kunden, die gemeinsam ein Konto führen maximal 9 Jahre auseinander liegen.
df_shared_accounts_o <- df_shared_accounts %>%
filter(disp_type == 'owner') %>%
select(-age_grouped, -age_grouped_desc)
df_shared_accounts_d <- df_shared_accounts %>%
filter(disp_type == 'disponent') %>%
select(account_id, client_id, disp_type, gender, age)
df_shared_accounts_age <- df_shared_accounts_o %>%
left_join(df_shared_accounts_d, by = 'account_id') %>%
mutate(
diff_age = age.x - age.y
)
summary(df_shared_accounts_age$diff_age)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -9.0000 -4.0000 0.0000 -0.1266 4.0000 8.0000Um die Vermutung zu erhärten, wird zusätzlich der Wohnort der Kunden analysiert. Insgesamt sind es 869 Konten die gemeinsam geführt werden. Bei allen Konten ist der Wohndistrikt des Eigentümers identisch mit demjenigen der Verfügungsberechtigten Person.
df_shared_accounts %>%
select(account_id, disp_type, district_client, gender, age) %>%
arrange(account_id) %>%
select(-disp_type, -gender, -age) %>%
distinct()2.5.2 Konto mit einem Kunden
Für die Analyse werden Daten aus den Tabellen account, disp und client verwendet. Darauf wird der Filter auf den Kontotyp “single account” angewendet.
df_single_accounts <- df_account_disp_client %>%
filter(
account_type == 'single account'
)
df_single_accounts %>% ggplot(aes(x = age, color = gender)) +
geom_density(size = 1) +
labs(title = 'Altersverteilung von Kunden, die alleine ein Konto führen',
subtitle = paste0("Anzahl Observationen = ", nrow(df_single_accounts)),
x = 'Alter',
y = 'Dichte',
color = 'Geschlecht'
)
Diese Altersverteilung deckt sich mit derjenigen über alle Kunden. Es gibt nur kleinere Unterschiede nach Geschlecht.
df_single_accounts %>% ggplot(aes(x = gender)) + geom_bar() +
geom_text(aes(label = ..count..), stat = "count", vjust = -0.5, color = 'black') +
labs(title = 'Altersverteilung von Kunden, die alleine ein Konto führen',
subtitle = paste0("Anzahl Observationen = ", nrow(df_single_accounts)),
x = 'Geschlecht',
y = 'Anzahl Kunden'
)
3 Zahlungen
Für die Analyse der Verbindung von Transaktionen und Konten, werden Daten aus den Tabellen trans, account, disp und client verwendet. Der Zeitraum der Daten ist 01.01.1993 - 31.12.1998.
df_trans_account_client_disp <- df_trans_account_client_disp %>%
filter(disp_type == 'owner')
df_trans_account_client_disp %>% ggplot(aes(x = trans_type)) + geom_bar() +
geom_text(aes(label = ..count..), stat = "count", vjust = -0.5, color = 'black') +
labs(title = 'Verteilung Gutschrift/Belastung',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Zahlungstyp',
y = 'Anzahl Transaktionen'
)
Insgesamt wurden 1.5 mal so viele Belastungen wie Gutschriften getätigt. Aufgrund der Verbindung der Tabellen trans und account ist wiederum eine Zuordnung einer Zahlung auf den einzelnen Kunden nicht möglich.
df_trans_account_client_disp %>%
group_by(trans_type) %>%
summarise(sum_trans_amount = floor(sum(trans_amount))) %>%
ungroup() %>%
ggplot(aes(x = trans_type, y = sum_trans_amount)) + geom_bar(stat = 'identity') +
geom_text(aes(label=sum_trans_amount), position=position_dodge(width=0.9), vjust=-0.25) +
labs(title = 'Summe der Betragshöhe Gutschrift/Belastung',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Zahlungstyp',
y = 'Summierte Betragshöhe'
)
Betragsmässig überwiegen die Gutschriften die Belastungen aber um 197 Millionen CZK.
3.1 Entwicklung über Zeit
Eine Hypothese des Konzepts vermutete ein Anstieg der Anzahl Zahlungen über den Jahreswechsel.
df_trans_account_client_disp %>% ggplot(aes(x = trans_date, color = trans_type)) +
geom_density(size = 1) +
labs(title = 'Verteilung Gutschrift/Belastung über Zeit',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Zeit',
y = 'Dichte',
color = 'Zahlungstyp'
)
Während sich die Gutschriften linear entwickeln, schlägt die Anzahl Belastungen um den Jahreswechsel aus. Die Zeit um den Jahreswechsel ist neben erhöhten Ausgaben für Weihnachtsgeschenke auch beliebt für Einkäufe, insbesondere auch Schnäppchentouren. Es gibt auch jährlich, auf Anfang Jahr, fällige Rechnungen wie z.B. die Krankenkassenprämien.
#Analysing the different transaction types according to age and Zeit
df_trans_credit <- filter(df_trans_account_client_disp, trans_type == 'credit')
df_trans_credit %>% ggplot(aes(x = trans_date, color = operation)) +
geom_density(size = 1) +
labs(title = 'Verteilung Zahlungsarten von Gutschriften über Zeit',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_credit)),
x = 'Zeit',
y = 'Dichte',
color = 'Zahlungart'
)
Eine detailliertere Untersuchung der Gutschriften über den Zeitraum 01.01.1993 - 31.12.1998 ist nicht erkennbar.
df_trans_withdrawal <- filter(df_trans_account_client_disp, trans_type == 'withdrawal')
df_trans_withdrawal %>% ggplot(aes(x = trans_date, color = operation)) +
geom_density(size = 1) +
labs(title = 'Verteilung Zahlungsarten von Belastungen über Zeit',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_withdrawal)),
x = 'Zeit',
y = 'Dichte',
color = 'Zahlungsart'
)
Eine genauere Betrachtung der Belastungen zeigt deutliche Unterschiede. Insbesondere ist erkennbar, dass Kreditkarten und Barbezüge für den starken Anstieg über den Jahreswechsel verantwortlich sind. Die Vermutung liegt nahe, dass dies mit einem erhöhten Einkaufsverhalten über die Festtage korreliert. Überweisungen an eine andere Bank sind stabil.
3.2 Altersverteilung
df_trans_account_client_disp %>% ggplot(aes(x = age, color = trans_type)) +
geom_density(size = 1) +
labs(title = 'Altersverteilung der Kunden',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Alter',
y = 'Dichte',
color = 'Zahlungstyp'
)
Auf der Ebene Gutschrift/Belastung sind keine signifikanten Unterschiede in der Altersverteilung sichtbar.
3.3 Zahlungsart
df_trans_account_client_disp %>% ggplot(aes(x = trans_type, fill = operation)) + geom_bar() +
geom_text(aes(label = ..count..), stat = "count", position = position_stack(vjust = 0.5), color = 'black') +
labs(title = 'Verteilung Zahlungsgart nach Gutschrift/Belastung',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Zahlungstyp',
y = 'Anzahl Transaktionen',
fill = 'Zahlungsart'
)
Die Untersuchung nach der Art der Zahlung zeigt deutliche Unterschiede. Überraschend ist, die hohe Anzahl an Belastungen in bar gegenüber der Überweisung an eine andere Bank respektive Kreditkartenbelastung. Möglicherweise gibt es noch kein Online-Banking, sodass Banküberweisungen am Schalter getätigt werden müssen.
Auch bei den Gutschriften erfolgt eine signifikante Anzahl in bar.
df_trans_account_client_disp %>%
group_by(trans_type, operation) %>%
summarise(sum_trans_amount = floor(sum(trans_amount))) %>%
ungroup() %>%
ggplot(aes(x = operation, y = sum_trans_amount, fill = trans_type)) + geom_bar(stat = 'identity') +
geom_text(aes(label=sum_trans_amount), position=position_dodge(width=0.9), vjust=-0.25) +
labs(title = 'Summe der Betragshöhe Gutschrift/Belastung',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Zahlungsart',
y = 'Summierte Betragshöhe',
fill = 'Zahlungstyp'
)## `summarise()` has grouped output by 'trans_type'. You can override using the `.groups` argument.
Bei der genaueren Betrachtung der Verteilung der aufsummierten Betragshöhe nach Zahlungsgrund ist erkennbar, dass die Zahlungsart-Pendants credit/withdrawal in cash, collection from other bank und remittance to other bank sowie die ohne Angabe der Zahlungsart in der Betragshöhe sehr ähnlich sind. Es ist erstaunlich, dass auch betragsmässig das meiste Geld in bar fliesst.
df_trans_account_client_disp %>% ggplot(aes(x = age, color = trans_type)) +
geom_density(size = 1) + facet_wrap(~ operation) +
labs(title = 'Altersverteilung der Kunden',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Alter',
y = 'Dichte',
color = 'Zahlungstyp'
)
Die Untersuchung einzelner Zahlungsarten zeigt interessante Muster: - Menschen ab ca. 60 Jahren tätigen generell weniger Zahlungen (ausser bei Gutschriften von anderen Banken) - Die Altersverteilung bei der Anzahl Zahlungen ist bei Kunden, die zwischen 20 und 60 Jahre alt sind, stabil (ausser bei Gutschriften von anderen Banken und Belastungen der Kreditkarte) - Zahlungen von anderen Banken erhalten Menschen ab 60 Jahren viel öfter - möglicherweise Rentenzahlungen - Menschen bis ca. 25 Jahre tätigen häufiger Kreditkarten Belastungen
3.4 Zahlungsgrund
df_trans_account_client_disp %>% ggplot(aes(x = trans_type, fill = trans_character)) + geom_bar() +
geom_text(aes(label = ..count..), stat = "count", position = position_stack(vjust = 0.5), color = 'black') +
labs(title = 'Verteilung Zahlungsgrund nach Gutschrift/Belastung',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Zahlungstyp',
y = 'Anzahl Transaktionen',
fill = 'Zahlungsgrund'
)
Viele Zahlungen, unabhängig ob Gutschrift oder Belastung, werden ohne die Angabe eines Grundes getätigt. Kein expliziter Zahlungsgrund wird bei beiden Zahlungstypen - also Gutschrift oder Belastung - verwendet. Interessant ist die hohe Anzahl Belastungen für Bankbelege. Wobei eine hohe Anzahl Transaktionen nicht ein hoher Betrag bedeutet.
Neben Karten und Krediten gibt es die Möglichkeit, Daueraufträge für ein Konto zu erfassen. In der Tabelle order gibt es fünf Gründe von Daueraufträge, neben denjenigen ohne Angabe eines Grundes: household, loan payment, insurrance payment und leasing. Auffällig ist, dass scheinbar keine Transaktionen mit dem Grund leasing ausgeführt worden sind. Möglicherweise wurde bei leasing-Transaktionen kein Zahlungsgrund angegeben.
df_trans_account_client_disp %>%
group_by(trans_type, trans_character) %>%
summarise(sum_trans_amount = floor(sum(trans_amount))) %>%
ungroup() %>%
ggplot(aes(x = trans_character, y = sum_trans_amount, fill = trans_type)) + geom_bar(stat = 'identity') +
labs(title = 'Summe der Betragshöhe Gutschrift/Belastung',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Zahlungsgrund',
y = 'Summierte Betragshöhe',
fill = 'Zyhlungstyp'
)## `summarise()` has grouped output by 'trans_type'. You can override using the `.groups` argument.
Zahlungen ohne Angabe eines Grundes überwiegen deutlich. Für eine bessere Übersicht der Verteilungen von Zahlungen mit Grund, werden diese heraus gefiltert.
df_trans_account_client_disp %>%
filter(trans_character != 'not known') %>%
group_by(trans_type, trans_character) %>%
summarise(sum_trans_amount = floor(sum(trans_amount))) %>%
ungroup() %>%
ggplot(aes(x = trans_character, y = sum_trans_amount, fill = trans_type)) + geom_bar(stat = 'identity') +
geom_text(aes(label=sum_trans_amount), position=position_dodge(width=0.9), vjust=-0.25) +
labs(title = 'Summe der Betragshöhe Gutschrift/Belastung',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Zahlungsgrund',
y = 'Summierte Betragshöhe',
fill = 'Zahlungstyp'
)## `summarise()` has grouped output by 'trans_type'. You can override using the `.groups` argument.
Wie bereits angenommen, werden zwar viele Belastungen für Bankbelege ausgeführt. Im Betrag spiegelt sich die hohe Anzahl an Zahlungen aber nicht mit einem hohen aufsummierten Betrag wieder.
df_trans_account_client_disp %>% ggplot(aes(x = age, color = trans_type)) +
geom_density(size = 1) + facet_wrap(~ trans_character) +
labs(title = 'Altersverteilung der Kunden',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Alter',
y = 'Dichte',
color = 'Zahlungstyp'
)
df_trans_account_client_disp %>% ggplot(aes(x = age, color = trans_character)) +
geom_density(size = 1) + facet_wrap(~trans_type) +
labs(title = 'Altersverteilung der Kunden',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_account_client_disp)),
x = 'Alter',
y = 'Dichte',
color = 'Zahlungstyp'
)
Bei der Untersuchung der Altersverteilung der Zahlungsgründe fällt nur die Ausgabe für Altersheime auf. Diese steigt per Personen ab 60 Jahren leicht und bei Personen ab ca. 65 Jahren sehr deutlich.
4 Soziodemographische Analysen
Der Austausch mit anderen Studierenden ergaben, dass die soziodemographischen Informationen praktisch keinen Einfluss auf die Produkteverteilung der Kunden haben. In diesem Bericht werden diese Informationen nicht berücksichtigt. Die Begründung dafür sind fehlende zeitliche Ressourcen.
5 Produktspezifische Analysen
Die Analysen im vorherigen Kapitel dienten dazu einen Überblick über die Bankkunden und ihr Verhalten zu gewinnen. Basierend auf diesen Analysen werden in diesem Kapitel die Produkte der Bank, namentlich Karten, Kredite und Daueraufträge analysiert.
Für die folgenden Analysen wurden nur die Eigentümer eines Kontos untersucht. Das Analyse im ersten Teil des Berichts hat ergeben, dass ein Produkt (Kredite und Dauaeraufträge) entweder mit dem Konto verbunden ist und deshalb - bei gemeinsamen Konten - nicht einem Kunden zugewiesen werden kann oder dass die Eigentümer der Konten ein Produkt (Karte) besitzen. Würden die jeweiligen Verfügungsberechtigten von gemeinsam geführten Konten nicht heraus gefiltert, würden diese die Berechnung verfälschen, indem sie resp. der Kontostand dieses Kontos in die Berechnungen von Kunden ohne Konto hineinfliesst. Eben dieser Kontostand ist aber richtigerweise in der Berechnung für Kunden mit Produkten, berücksichtigt.
Für die Analysen werden Daten aus allen Tabellen, ausser district, verwendet. Der Zeitraum ist vom 01.01.1993 - 31.12.1998.
df_help_age <- df_products_all %>%
group_by(product, product_type) %>%
summarise(
avg_producttype_age = mean(age),
med_producttype_age = median(age)
) %>%
ungroup()## `summarise()` has grouped output by 'product'. You can override using the `.groups` argument.df_products_all <- left_join(df_products_all, df_help_age, by = c("product", "product_type"))df_trans_products_all <- df_trans_products_all %>%
mutate(
trans_year = year(trans_date),
trans_week = week(trans_date)
)
df_help_products1 <- df_trans_products_all %>%
group_by(product, account_id, trans_year, trans_week) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
group_by(product, trans_year, trans_week) %>%
summarise(
avg_product_balance = mean(balance),
med_product_balance = median(balance),
product_last_date = max(trans_date)
) %>%
ungroup()
df_trans_products_all <- left_join(df_trans_products_all, df_help_products1, by = c("trans_year", "trans_week", "product"))df_help_products2 <- df_trans_products_all %>%
group_by(product, product_type, account_id, trans_year, trans_week) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
group_by(product, product_type, trans_year, trans_week) %>%
summarise(
avg_producttype_balance = mean(balance),
med_product_type_balance = median(balance),
producttype_last_date = max(trans_date)
) %>%
ungroup()
df_trans_products_all <- left_join(df_trans_products_all, df_help_products2, by = c("trans_year", "trans_week", "product", "product_type"))df_trans_card_all <- df_trans_card_all %>%
mutate(
trans_year = year(trans_date),
trans_week = week(trans_date)
)
df_help_card <- df_trans_card_all %>%
group_by(card, card_type, account_id, trans_year, trans_week) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
group_by(card, card_type, trans_year, trans_week) %>%
summarise(
avg_cardtype_balance = mean(balance),
med_cardtype_balance = median(balance),
cardtype_last_date = max(trans_date)
) %>%
ungroup()
df_trans_card_all <- left_join(df_trans_card_all, df_help_card, by = c("trans_year", "trans_week", "card", "card_type"))df_trans_loan_all <- df_trans_loan_all %>%
mutate(
trans_year = year(trans_date),
trans_week = week(trans_date)
)
df_help_loan <- df_trans_loan_all %>%
group_by(loan, duration, account_id, trans_year, trans_week) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
group_by(loan, duration, trans_year, trans_week) %>%
summarise(
avg_loanduration_balance = mean(balance),
med_loanduration_balance = median(balance),
loanduration_last_date = max(trans_date)
) %>%
ungroup()
df_trans_loan_all <- left_join(df_trans_loan_all, df_help_loan, by = c("trans_year", "trans_week", "loan", "duration"))# df_help_loan2 <- df_trans_loan_all %>%
# group_by(loan, loan_status, account_id, trans_year, trans_week) %>%
# arrange(trans_date) %>%
# summarise_all(last) %>%
# ungroup() %>%
# group_by(loan, loan_status, trans_year, trans_week) %>%
# summarise(
# avg_loanstatus_balance = mean(balance),
# med_loanstatus_balance = median(balance),
# loanstatus_last_date = max(trans_date)
# ) %>%
# ungroup()
#
# df_trans_loan_all <- left_join(df_trans_loan_all, df_help_loan2, by = c("trans_year", "trans_week", "loan", "loan_status"))df_help_loan3 <- df_trans_loan_all %>%
group_by(loan, status, account_id, trans_year, trans_week) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
group_by(loan, status, trans_year, trans_week) %>%
summarise(
avg_loan_status_balance = mean(balance),
med_loan_status_balance = median(balance),
Loan_status_last_date = max(trans_date)
) %>%
ungroup()
df_trans_loan_all <- left_join(df_trans_loan_all, df_help_loan3, by = c("trans_year", "trans_week", "loan", "status"))df_trans_order_all <- df_trans_order_all %>%
mutate(
trans_year = year(trans_date),
trans_week = week(trans_date)
)
df_help_order <- df_trans_order_all %>%
group_by(order, account_id, trans_year, trans_week) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
group_by(order, trans_year, trans_week) %>%
summarise(
avg_order_balance = mean(balance),
med_order_balance = median(balance),
order_last_date = max(trans_date)
) %>%
ungroup()
df_trans_order_all <- left_join(df_trans_order_all, df_help_order, by = c("trans_year", "trans_week", "order"))5.1 Produkt vs. kein Produkt
5.1.1 Anzahl Konten mit Produkten
df_products_all %>%
ggplot(aes(x = product)) + geom_bar() + geom_text(aes(label = ..count..), stat = "count", vjust = -0.1, colour = 'black') +
labs(title = 'Verteilung nach Produkt/kein Produkt',
subtitle = paste0("Anzahl Observationen = ", nrow(df_products_all)),
y = 'Anzahl Konten mit Produkt'
)
Rund 87 % aller Konten bei der Bank sind mit mindestens einem Produkt verknüpft. Doe nächste Analyse zeigt, die Verteilung, welche Produkte häufig besitzt werden.
df_products_all %>%
filter(product == 'yes') %>%
ggplot(aes(x = product_type)) + geom_bar() + geom_text(aes(label = ..count..), stat = "count", vjust = -0.1, colour = 'black') +
labs(title = 'Verteilung nach Produkttyp',
subtitle = paste0("Anzahl Observationen = ", nrow(df_products_all)),
x = 'Produkttyp',
y = 'Anzahl Konten mit Produkt'
)
Von den 3948 Konten mit Produkt haben 2/3 Daueraufträge erfasst. Deutlich weniger Kunden, also nur 10 % haben zusätzlich eine Karte oder einen Kredit. Nicht einmal 5 % besitzen nur eine Karte. Alle Produkte besitzen nur 4 % der Kunden. Bei Kunden die alle Produkte besitzen wird unterschieden, ob sie zuerst eine Karte kauften und dann einen Kredit aufnahmen (card, loan, order) oder umgekehrt (loan, card, order).
5.1.2 Berechnung des Zeitpunkts eines Produktebezugs nach Kontoeröffnung
Die folgende Analyse untersucht neben dem Zeitpunkt eines Produktebezugs auch inwieweit das Verhalten innerhalb der Kundengruppe heterogen ist. Dafür wird neben dem arithmetischen Mittel auch der Median als Lagemass herangezogen, da er stabiler auf Ausreisser reagiert. Die Differenz zwischen arithmetischem Mittel und Median gibt Auskunft über Ausreisser.
Die Spalten bezeichnen die Zeit, die ab Kontoeröffnung bis zur Ausstellung des Produkts vergeht. Dabei wird vom Datum des Produktebezugs “zurück” gerechnet.
5.1.2.1 Kunden mit Kredit und Karte
df_products_all %>%
filter(loan == 'yes' & (card == 'yes' & loan_date < issued_date)) %>%
summarise(
avg_loan = mean(loan_diff_time),
med_loan = median(loan_diff_time),
avg_card = mean(card_diff_time),
med_card = median(card_diff_time)
)Für diese Berechnung wurden Kunden analysiert, die eine Karte und einen Kredit besitzen - unabhängig ob sie auch ein Dauerauftrag haben. Ein Kunde mit Karte und Kredit hat im Schnitt gut ein Jahr nach Kontoeröffnung einen Kredit erhalten. Im Schnitt zwei Jahre nach Kontoeröffnung kam das Produkt Karte hinzu. Arithmetisches Mittel und Median weichen kaum voneinander ab. Bei der Karte ist die Abweichung grösser, aber immer noch nicht in einem relevanten Ausmass. Für die weitere Analyse dieser Kundengruppe ist das von Vorteil, da ihr Verhalten stabil ist.
5.1.2.2 Kunden mit Karte und Kredit
df_products_all %>%
filter(card == 'yes' & (loan == 'yes' & issued_date < loan_date)) %>%
summarise(
avg_card = mean(card_diff_time),
med_card = median(card_diff_time),
avg_loan = mean(loan_diff_time),
med_loan = median(loan_diff_time)
)5.1.2.3 Kunden mit Karte (ohne Kredit)
df_products_all %>%
filter(card == 'yes' & loan == 'no' & account_date < issued_date) %>%
summarise(
avg = mean(card_diff_time),
med = median(card_diff_time),
)Für diese Berechnung wurden Kunden analysiert, die eine Karte aber keinen Kredit besitzen - unabhängig ob sie auch ein Dauerauftrag haben. Ein Kunde nur mit Karte hat im Schnitt gut zwei Jahre nach Kontoeröffnung die Karte bezogen. Der Median liegt aber bei 1.8 Jahren, das bedeuet es gibt einige Ausreisser nach “oben”, also Kunden, die eine Karte erst später bezogen haben.
5.1.2.4 Kunden mit Kredit (ohne Karte)
df_products_all %>%
filter(loan == 'yes' & account_date < loan_date) %>%
summarise(
max(loan_diff_time),
avg = mean(loan_diff_time),
med = median(loan_diff_time),
)Für diese Berechnung wurden Kunden analysiert, die einen Kredit aber keine Karte besitzen - unabhängig ob sie auch ein Dauerauftrag haben. Ein Kunde nur mit Kredit hat im Schnitt gut ein Jahr nach Kontoeröffnung diesen bezogen. Es scheint keine Ausreisser zu geben, da Abweichung von arithmetischem Mittel und Median minim sind. Für die weitere Analyse dieser Kundengruppe von Vorteil, da das Verhalten stabil ist.
Die Vermutung, dass ein Kunden ein Konto eine gewisse Zeit ein Konto besitzen muss, bevor ein Kreditantrag möglich ist, kann widerlegt werden, indem die kürzeste Zeit von Kontoeröffnung bis zum Kreditbezug analysiert wird. Diese beträgt gut drei Monate.
5.1.3 Entwicklung des Vermögens
Die folgende Analyse untersucht die Entwicklung des Vermögens über Zeit. Dazu wird wiederum das arithmetische Mittel und der Median als Lagemasse herangezogen.
Die Berechnung basiert auf dem letzten Kontostand pro Woche. Die Berechnung ist leicht verfälscht, da eine korrekte Sortierung sehr komplex ist und in den Analysen in Kauf genommen wird.
df_corr1 <- df_trans_account_client_disp %>%
filter(disp_type == 'owner') %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
group_by(age) %>%
summarise(
mean = mean(balance),
median = median(balance)
)
ggscatter(df_corr1, x = 'age', y = 'mean', add = 'reg.line', conf.int = TRUE, cor.coef = TRUE, cor.method = 'spearman') +
labs(title = 'Korrelation zwischen Alter und Vermögen der Kunden per 31.12.1998',
x = 'Alter',
y = 'Vermögen'
)## `geom_smooth()` using formula 'y ~ x'
ggscatter(df_corr1, x = 'age', y = 'mean', add = 'reg.line', conf.int = TRUE, cor.coef = TRUE, cor.method = 'pearson') +
labs(title = 'Korrelation zwischen Alter und Vermögen der Kunden per 31.12.1998',
x = 'Alter',
y = 'Vermögen'
)## `geom_smooth()` using formula 'y ~ x'
df_corr1 %>%
ggplot(aes(x = age, y = median)) +
geom_point() +
labs(title = 'Korrelation zwischen Alter und Vermögen der Kunden per 31.12.1998',
x = 'Alter',
y = 'Vermögen'
)
df_corr1 %>%
ggplot(aes(x = age, y = median)) +
geom_smooth(color = 'gray37') +
labs(title = 'Korrelation zwischen Alter und Vermögen der Kunden per 31.12.1998',
x = 'Alter',
y = 'Vermögen'
)## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
Das Vermögen von Kunden korrelliert mit -0.7 realtiv stark. Für die Berechnung wurde die Spearman Methode verwendet, da sich die beiden kontinuierlichen Variablen Alter und Vermögen wohl gemeinsam verändern, jedoch nicht mit einem konstanten Abstand, also nicht linear. Der Korrelationskoeffizient von -0.56 beziffert eine vorhandene negative Korrelation zwischen Alter und Vermögen.
5.1.3.1 Produkt vs. kein Produkt
df_trans_products_all %>%
ggplot(aes(x = product_last_date, y = avg_product_balance, color = product)) + geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit Produkt vs. ohne Produkt',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_products_all)),
x = 'Zeit',
y = 'Vermögen (Arithmetisches Mittel)',
color = 'Produkt vorhanden'
)
df_trans_products_all %>% ggplot(aes(x = product_last_date, y = med_product_balance, color = product)) + geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit Produkt vs. ohne Produkt',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_products_all)),
x = 'Zeit',
y = 'Vermögen (Median)',
color = 'Produkt vorhanden'
)
Zwischen Kunden mit Produkten gegenüber Kunden ohne Produkte sind nur geringe Abweichungen erkennbar. Auffällig ist die Abweichung vom durschnittlichen Vermögen zum Median von ca. 5000 CZK. Dies deutete auf eine rechtsschiefe Verteilung des Vermögens hin.
df_trans_products_all %>%
ggplot(aes(x = balance)) +
geom_density() +
labs(title = 'Verteilung des Vermögens',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_products_all)),
x = 'Vermögen in CZK',
y = 'Dichte'
)
Eine einfache Dichteverteilung auf das Vermögen, bestätigt diese Vermutung.
df_trans_products_all %>%
ggplot() +
geom_density(aes(x = avg_product_balance), color = 'red') +
geom_density(aes(x = med_product_balance), color = 'chartreuse4') +
labs(title = 'Abweichung Kontostand von Kunden mit Produkt vs. ohne Produkt',
subtitle = 'Rote Kurve: Durschnittliches Vermögen\nGrüne Kurve: Vermögen (Median)',
x = 'Vermögen in CZK',
y = 'Dichte'
)
Die Abweichung vom durchschnittlichen Vermögen zum Median ist mit dieser Visualisierung noch besser sichtbar.
5.1.3.2 Produkt-Typen vs. kein Produkt
df_trans_products_all %>%
ggplot(aes(x = producttype_last_date, y = avg_producttype_balance, color = product_type)) +
geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit unterschiedlichen Produkttypen',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_products_all)),
x = 'Zeit',
y = 'Vermögen (Arithmetisches Mittel)',
color = 'Produkttyp'
)
df_trans_products_all %>%
ggplot(aes(x = producttype_last_date, y = med_product_type_balance, color = product_type)) +
geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit unterschiedlichen Produkttypen',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_products_all)),
x = 'Zeit',
y = 'Vermögen (Median)',
color = 'Produkttyp'
)
Deutliche Abweichungen sind bei der Analyse von unterschiedlichen Produkttypen erkennbar. Aufgrund der Überlagerung der Linien ist eine detaillierte Analyse schwierig. Auffallend ist, arithmetisches Mittel und Median relativ nahe beieinander liegen, der Median aber breiter streut.
df_trans_products_all %>%
ggplot() +
geom_density(aes(x = avg_producttype_balance), color = 'red') +
geom_density(aes(x = med_product_type_balance), color = 'chartreuse4') +
labs(title = 'Abweichung Kontostand von Kunden mit unterschiedlichen Produkten',
subtitle = 'Rote Kurve: Durschnittliches Vermögen\nGrüne Kurve: Vermögen (Median)',
x = 'Vermögen in CZK',
y = 'Dichte'
)
Für nahcfolgende Analysen wird der Median des Vermögens als Berechnungsgrundlage herangezogen.
Von der reinen Betrachtung der vorherigen Grafiken, lassen sich zwei Kundengruppen mit ähnlichen Vermögen bilden:
Gruppe 1: Kunden mit den Produkten - Karte - Karte und Kredit - Karte und Dauerauftrag - Karte, Kredit und Dauerauftrag (unabhängig der Reihenfolge)
Gruppe 2: Kunden mit den Produkten - Dauerauftrag - Kredit - Kredit und Dauerauftrag
Es verwundert nicht, dass Kunden mit einem Kredit ein tieferes Vermögen haben. Hätten sie ein höhreres Vermögen, würden sie vermutlich keinen Kredit benötigen.
Aus der Abbildung ersichtlich ist, dass sich “die Schere” zwischen Kunden der Gruppe 1 und 2 öffnet. Beide starten mit einem ähnlichen Vermögen zwischen 30000 und 45000 CZK. Während die Vermögensentwicklung von Gruppe 2 nur minimal ist, kann Gruppe 1 ihr Vermögen auf ca. 50000 - 60000 steigern.
Gruppe 1:
df_trans_products_all %>%
filter(product_type == 'card' | product_type == 'card, loan' | product_type == 'card, order' | product_type == 'card, loan, order' | product_type == 'loan, card, order') %>%
ggplot(aes(x = producttype_last_date, y = med_product_type_balance, color = product_type)) +
geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit unterschiedlichen Produkttypen',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_products_all)),
x = 'Zeit',
y = 'Vermögen (Median)',
color = 'Produkttyp'
)
Selbst eine Filterung nur auf Produkte der Gruppe 1 erzeugt einen kleinen Mehrwert. Das Vermögen liegt zwischen 30000 CZK und 40000 CZK und steigt auf über 60000 bis zum 31.12.1998. Eine detailliertere Analyse der Vermögensentwicklung in Zahlen folgt später in diesem Bericht.
Gruppe 2:
df_trans_products_all %>%
filter(product_type == 'no product' | product_type == 'order' | product_type == 'loan, order' | product_type == 'loan') %>%
ggplot(aes(x = producttype_last_date, y = avg_producttype_balance, color = product_type)) +
geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit unterschiedlichen Produkttypen',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_products_all)),
x = 'Zeit',
y = 'Vermögen (Median)',
color = 'Produkttyp'
)
Die Filterung auf Produkte der Gruppe 2 birgt deutlich mehr Informationen, liegt der Unterschied von Kunden mit nur Daueraufträgen zu Kunden mit einem Kredit und Daueraufträgen bei 10000 CZK. Das Vermögen ist per 31.12.1998 deutlich tiefer als bei Gruppe 1. Entwickelt sich das Vermögen von Gruppe 1 um bis zu 30000 CZK, ist die Entwicklung von Gruppe 2 nur ca. 10000 CZK.
5.1.3.3 Altersverteilung nach Produkttypen
Aufgrund der bisherigen Analysen lässt sich vermuten, dass die Altersverteilung von Kundengruppe 1 und 2 möglicherweise ähnlich sind, da Alter und Vermögen korrelieren.
Gruppe 1:
df_trans_products_all %>%
filter(product_type == 'card' | product_type == 'card, loan' | product_type == 'card, order' | product_type == 'card, loan, order' | product_type == 'loan, card, order') %>%
ggplot(aes(x = age, fill = gender)) +
geom_density(alpha = 0.4) +
facet_wrap(~product_type) +
labs(title = 'Altersverteilung nach unterschiedlichen Produkttypen',
x = 'Alter',
y = 'Dichte',
fill = 'Geschlecht'
)
Die Altersverteilung der Kunden mit den Produkten - Karte und Kredit - Kredit, Karte und Dauerauftrag ähneln sich stark und entsprechen der Altersverteilung aller Kunden. Es gibt nur geringfügige Unterschiede beim Geschlecht.
Die Altersverteilungen von Kunden mit entweder - Karte und Kredit - Karte, Kredit und Dauerauftrag schwanken stark. Die Kurve schlägt an zwei respektive drei Stellen aus. Vorallem jungen Kunden im Alter von etwa 25 Jahren oder Kunden im Alter von etwa 50 Jahren beziehend Kredite. Der Grund für diese Anomalien müsste genauer untersucht werden, insbesondere auch die deutlichen Unterschiede beim Geschlecht.
Die Altersverteilung von Kunden mit einer Karte nimmt leicht ab. Dies wird später im Bericht noch genauer untersucht.
Gruppe 2:
df_trans_products_all %>%
filter(product_type == 'no product' | product_type == 'order' | product_type == 'loan, order' | product_type == 'loan') %>%
ggplot(aes(x = age, fill = gender)) +
geom_density(alpha = 0.4) +
facet_wrap(~product_type) +
labs(title = 'Altersverteilung nach unterschiedlichen Produkttypen',
x = 'Alter',
y = 'Dichte',
fill = 'Geschlecht'
)
Die Altersverteilung von Kunden mit nur einem Kredit varriert im Vergleich zur Altersverteilung über alle Kunden eher wieder stärker. Auffällig ist die Anomalie von älteren Kunden. Dies lässt vermuten, dass Kunden für die Bezahlung ihres Alltags oder des Altersheimes einen Kredit aufnehmen müssen, weil die Rente nicht reicht.
Die Altersverteilung der Kunden mit den Produkten - Dauerauftrag - Kredit und Dauerauftrag ähneln sich stark und entsprechen der Altersverteilung aller Kunden. Es gibt nur geringfügige Unterschiede beim Geschlecht.
Kunden ohne Produkt sind tendentiell jünger, da eine rückläufige Korrelation zwischen Vermögen und Alter besteht, sollten bei jüngeren Kunden Produkte beworben werden.
5.1.3.4 Entwicklung in relativen Zahlen
Um eine noch präzisere Aussage über die Entwicklung des Vermögens machen zu können, wird für einzelne Produkttypen ein “5 number summary” erstellt. Folgende zwei Situationen werden damit abgebildet: - die realtive Entwicklung des Vermögens für alle Kunden mit diesem Produkttyp - die realtive Entwicklung des Vermögens weiter aufgeteilt nach z.B. Kartentyp und/oder Kreditstatus
Für die Berechnung der relativen Entwicklung wird das Vermögen des letzten Kontostandes vor dem Erwerb des Produkts mit dem letzten Kontostand per 31.12.1998 verglichen. Auch hier sind leichte Verfälschungen zu erwarten wegen der bereits mehrfach ausgeführten Problematik der Sortierung von mehreren Transaktionen eines Kontos pro Tag.
Eine relative Entwicklung von mindestens 1.0 wird als positiv gewertet. Entwicklungen kleiner als 1 als negativ.
Die visuelle Darstellung der nachfolgenden Analysen finden sich in den Kapiteln Karte vs. keine Karte und Kredit vs. kein Kredit.
5.1.3.4.1 Produkttyp: Karte, Kredit und Dauerauftrag
df_19981231_change <- df_19981231 %>%
select(account_id, balance) %>%
mutate(
balance_end = balance
)
df_cardloanorder_change <- df_trans_products_all %>%
filter(product_type == 'card, loan, order') %>%
filter(trans_date < issued_date) %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
mutate(
balance_start = balance,
card_time_years = interval(issued_date, max_date)/years(1)
)
df_cardloanorder_change <- df_cardloanorder_change %>%
left_join(df_19981231_change, by = "account_id") %>%
select(-balance.x, -balance.y) %>%
mutate(
change_relative_overall = balance_end/balance_start,
change_realtive_year = (balance_end/balance_start)^(1/card_time_years)
)
summary(df_cardloanorder_change$change_relative_overall) #relative change over all time## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.1410 0.8213 1.0802 1.3558 1.6520 3.7257summary(df_cardloanorder_change$change_realtive_year) #relative change per year## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.1467 0.9110 1.0423 2.2077 1.3664 39.2732Auffällig hier sind fast alle Kennzahlen. Die Differenz der kleinsten zur grössten Entwicklung ist sehr gross. Das erklärt auch sogleich die grosse Differenz von arithmetischem Mittel zu Median, da das arithmetische Mittel deutlich stärker auf Ausreisser reagiert. Da der Median kleiner ist als das arithmetische Mittel ist die Verteilung rechtsschief.
Kunden, welche dieses Produkt besitzen scheinen aber generell eine positive Entiwcklung zu erleben.
#relative change over all time
df_cardloanorder_change %>%
select(card_type, loan_status, status, change_relative_overall) %>%
group_by(card_type, loan_status, status) %>%
summarise(
Min = min(change_relative_overall),
first_Qu = quantile(change_relative_overall, 0.25),
Median = median(change_relative_overall),
Mean = mean(change_relative_overall),
third_Qu = quantile(change_relative_overall, 0.75),
Max = max(change_relative_overall)
)## `summarise()` has grouped output by 'card_type', 'loan_status'. You can override using the `.groups` argument.#relative change per year
df_cardloanorder_change %>%
select(card_type, loan_status, status, change_realtive_year) %>%
group_by(card_type, loan_status, status) %>%
summarise(
Min = min(change_realtive_year),
first_Qu = quantile(change_realtive_year, 0.25),
Median = median(change_realtive_year),
Mean = mean(change_realtive_year),
third_Qu = quantile(change_realtive_year, 0.75),
Max = max(change_realtive_year)
)## `summarise()` has grouped output by 'card_type', 'loan_status'. You can override using the `.groups` argument.Die weitere Aufteilung nach Kartentyp und Kreditstatus (ob noch laufend oder bereits abgeschlossen) geben noch viel mehr Auskunft. Da der Median kleiner oder gleich dem arithmetischen Mittel ist, sind die Verteilungen rechtsschief. Eine Ausnahme bilden zwei Produkttypen mit identischem arithmetischen Mittel und Median. Diese sind symmetrisch verteilt.
Kunden mit noch laufendem Kredit scheinen die niedrigere Entwicklung zu machen als Kunden mit einem erfolgreich zurück bezahlten Kredit.
Kunden mit einer junior-Karte und einem bereits erfolgreich zurück bezahltem Kredit scheinen die grösste Entwicklung zu erfahren. Da aber alle Kennzahlen gleich gross sind, gibt es vermutlich nur eine Person mit diesen Charakteristika.
Weiter ist erkennbar, dass je “besser” die Karte (junior –> classic –> gold) eine höhere Entwicklung erfolgt.
5.1.3.4.2 Produkttyp: Kredit, Karte und Dauerauftrag
df_loancardorder_change <- df_trans_products_all %>%
filter(product_type == 'loan, card, order') %>%
filter(trans_date < loan_date) %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
mutate(
balance_start = balance,
loan_time_years = interval(loan_date, max_date)/years(1)
)
df_loancardorder_change <- df_loancardorder_change %>%
left_join(df_19981231_change, by = "account_id") %>%
select(-balance.x, -balance.y) %>%
mutate(
change_relative_overall = balance_end/balance_start,
change_relative_year = (balance_end/balance_start)^(1/loan_time_years)
)
summary(df_loancardorder_change$change_relative_overall) #relative change over all time## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -451.816 0.851 1.196 -1.704 1.890 22.478summary(df_loancardorder_change$change_relative_year) #relative change per year## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.04038 0.89627 1.11659 1.17817 1.28819 6.34747 1Die Entwicklung der Kunden dieses Produkttyps sind zwar interessant, die Bank sollte hier aber unbedingt eine Stabilisierung anstreben. Der Median ist deutlich grösser als das arithmetische Mittel, was auf eine stark linksschiefe Verteilung hindeutet. Im Schnitt ist die Entwicklung rückläufig, der Median liegt allerdings bei 1.2. Dies deutet auf eine stark linksschiefe Verteilung hin.
Generell gut ist, dass die Entwicklung aber tendentiell positiv ist.
#relative change over all time
df_loancardorder_change %>%
select(loan_status, status, card_type, change_relative_overall) %>%
group_by(loan_status, status, card_type) %>%
summarise(
Min = min(change_relative_overall),
first_Qu = quantile(change_relative_overall, 0.25),
Median = median(change_relative_overall),
Mean = mean(change_relative_overall),
third_Qu = quantile(change_relative_overall, 0.75),
Max = max(change_relative_overall)
)## `summarise()` has grouped output by 'loan_status', 'status'. You can override using the `.groups` argument.#relative change per year
df_loancardorder_change %>%
filter(account_id != 2051) %>%
select(loan_status, status, card_type, change_relative_year) %>%
group_by(loan_status, status, card_type) %>%
summarise(
Min = min(change_relative_year),
first_Qu = quantile(change_relative_year, 0.25),
Median = median(change_relative_year),
Mean = mean(change_relative_year),
third_Qu = quantile(change_relative_year, 0.75),
Max = max(change_relative_year)
)## `summarise()` has grouped output by 'loan_status', 'status'. You can override using the `.groups` argument.Die weitere Aufteilung nach Kreditstatus (ob noch laufend oder bereits abgeschlossen) und Kartentyp geben noch viel mehr Auskunft. Das arithmetische Mittel ist häufig höher als der Median, das bedeutet die Verteilungen sind rechtsschief.
Wie bereits beim letzten Produkttyp scheint es drei Kunden zu geben, die alleine ihre Charakteristika erfüllen: - Ein Kunde mit einem aktiven Kreditstatus (active), bei der Rückzahlungen offen sind (client in debt) und gold-Karte - Ein Kunde mit einem abgeschlossenen aber noch offenen Kreditstatus (finished) und junior-Karte - Ein Kunde mit einem abgeschlossenen aber noch offenen Kreditstatus (finished) und classic-Karte
Negative Kreditstatus wirken sich eher schlechter auf die Entwicklung aus als positive. Eine Ausnahme bilden, die vermutlich wenigen Kunden, mit einem aktiven Kredit mit negativem Status und classic-Karte.
Kunden mit einem aktiven Kredit, mit einem positiven Status (OK so far oder no problems) entwickelten sich positiv. Besonders gut entwickelten sich Kunden mit einem erfolgreich zurück bezahlten Kredit, unabhängig vom Kartentyp.
5.1.3.4.3 Produkttypen: Karte sowie Karte und Dauerauftrag
df_cardorder_change <- df_trans_products_all %>%
filter(product_type == 'card' | product_type == 'card, order') %>%
filter(trans_date < issued_date) %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
mutate(
balance_start = balance,
card_time_years = interval(issued_date, max_date)/years(1)
)
df_cardorder_change <- df_cardorder_change %>%
left_join(df_19981231_change, by = "account_id") %>%
select(-balance.x, -balance.y) %>%
mutate(
change_relative_overall = balance_end/balance_start,
change_relative_year = (balance_end/balance_start)^(1/card_time_years)
)
summary(df_cardorder_change$change_relative_overall) #relative change over all time## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -48.8443 0.9103 1.1221 1.2080 1.4377 36.2320summary(df_cardorder_change$change_relative_year) #relative change per year## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.00 0.91 1.15 154.59 1.53 44821.01 2Durschnitt und Median liegen bei Kunden dieses Produkttyps realtiv nahe beieinander und sind beide über 1. Auch der Quartilsabstand ist relativ klein. Die extremen Werte der minimalen und maximalen Entwicklung sind deutliche Ausreisser. Der Median ist kleiner als das arithmetische Mittel, die Verteilung ist deshalb rechtsschief.
#relative change over all time
df_cardorder_change %>%
filter(account_id != 2089 & account_id != 2959) %>%
select(card_type, change_relative_overall) %>%
group_by(card_type) %>%
summarise(
Min = min(change_relative_overall),
first_Qu = quantile(change_relative_overall, 0.25),
Median = median(change_relative_overall),
Mean = mean(change_relative_overall),
third_Qu = quantile(change_relative_overall, 0.75),
Max = max(change_relative_overall)
)#relative change per year
df_cardorder_change %>%
filter(account_id != 2089 & account_id != 2959) %>%
select(card_type, change_relative_year) %>%
group_by(card_type) %>%
summarise(
Min = min(change_relative_year),
first_Qu = quantile(change_relative_year, 0.25),
Median = median(change_relative_year),
Mean = mean(change_relative_year),
third_Qu = quantile(change_relative_year, 0.75),
Max = max(change_relative_year)
)Die weitere Aufteilung nach Kartentyp zeigt geringe Unterschiede. Das arithmetische Mittel ist immer höher als der Median, das bedeutet die Verteilungen sind rechtsschief. Viele Kunden liegen mit ihrere relativen Entwicklung zwischen 0.9 und 1.5, was als positiv gewertet wird. Der Kartentyp hat weniger Einfluss darauf als gedacht.
Untersucht werden, sollten die Kunden mit negativer Entwicklung.
5.1.3.4.4 Produkttyp: Kredit und Dauerauftrag
df_loanorder_change <- df_trans_products_all %>%
filter(product_type == 'loan, order') %>%
filter(trans_date < loan_date) %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
mutate(
balance_start = balance,
loan_time_years = interval(loan_date, max_date)/years(1)
)
df_loanorder_change <- df_loanorder_change %>%
left_join(df_19981231_change, by = "account_id") %>%
select(-balance.x, -balance.y) %>%
mutate(
change_relative_overall = balance_end / balance_start,
change_relative_year = (balance_end/balance_start)^(1/loan_time_years)
)
summary(df_loanorder_change$change_relative_overall) #relative change over all time## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.5091 0.7496 1.1621 1.4726 1.6951 15.6878summary(df_loanorder_change$change_relative_year) #relative change per year## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.003 0.893 1.078 57.577 1.347 24785.252 11Kunden mit diesem Produkttyp entwickelten sich leicht positiv. Minimal und Maximalwert sind wieder deutlich. Auch der Quartilsabstand streckt sich hier mehr in die Länge. Die Verteilung ist rechtsschief, da das arithmetische Mittel grösser ist als der Median.
#realtive change overall time
df_loanorder_change %>%
filter(balance_end > 0) %>%
select(loan_status, status, change_relative_overall) %>%
group_by(loan_status, status) %>%
summarise(
Min = min(change_relative_overall),
first_Qu = quantile(change_relative_overall, 0.25),
Median = median(change_relative_overall),
Mean = mean(change_relative_overall),
third_Qu = quantile(change_relative_overall, 0.75),
Max = max(change_relative_overall)
)## `summarise()` has grouped output by 'loan_status'. You can override using the `.groups` argument.#relative change per year
df_loanorder_change %>%
filter(change_relative_overall > 0) %>%
select(loan_status, status, change_relative_year) %>%
group_by(loan_status, status) %>%
summarise(
Min = min(change_relative_year),
first_Qu = quantile(change_relative_year, 0.25),
Median = median(change_relative_year),
Mean = mean(change_relative_year),
third_Qu = quantile(change_relative_year, 0.75),
Max = max(change_relative_year)
)## `summarise()` has grouped output by 'loan_status'. You can override using the `.groups` argument.Nach der Aufteilung von Kreditstatus und status liegt das arithmetische Mittel immer noch deutlich über dem Median, was auf eine rechtsschiefe Verteilung hindeutet.
Ob ein Status positiv (OK so far, no problems) oder negativ (client in debt, loan not payed) ist, wirkt sich auf die Entwicklung aus. Kredit mit positivem Status entwickeln sich besser. Der positive Ausreisser bei den aktiven Krediten mit negativem Status wirkt sich verbessernd auf das arithmetische Mittel aus.
5.2 Vermögen zum Zeitpunkt des Produktebezugs
df_loancardorder_change %>%
ggplot(aes(x = balance_start)) +
geom_density() +
labs(title = 'Produkttyp Loandownload Kopie.png, Card, Order: Vermögen direkt vor Produktbezug',
x = 'Vermögen CZK',
y = 'Dichte'
)
Das Kurve des Vermögens ist eher rechtsschief. Diese Kunden hatten im Schnitt ein Jahr vor dem Kartenbezug einen Kredit bezogen.
df_cardloanorder_change %>%
ggplot(aes(x = balance_start)) +
geom_density(alpha = 0.4) +
labs(title = 'Produkttyp Card, Loan, Order: Vermögen direkt vor Produktbezug',
x = 'Vermögen CZK',
y = 'Dichte'
)
Kunden mit dem Produkttyp Karte, Kredit und Order hatten zuerst eine Karte bezogen und erst danach einen Kredit. Es ist eine Anomalie im Bereich von 40000 CZ und noch einmal im Bereich von 70000 CZK erkennbar.
Das Vermögen zum Zeitpukt des Produktebezugs der Produkttypen Karte, Karte und Dauerauftrag sowie Kredit und Dauerauftrag werden später analysiert.
5.3 Überleitung
Wurden im vorhergehenden Kapitel einzelne Produkttypen detailliert analysiert, beinhalten die folgenden Kapitel Analysen auf der Stufe Karte gegenüber keine Karte. In einer Vertiefung werden Kunden mit einer Karte nochmals genauer analysiert, aber immer nur in obiger Abgrenzung und nicht mehr im Detailgrad wie im vorhergehenden Kapitel.
5.4 Karte vs. keine Karte
5.4.1 Anzahl Konten mit Karte
df_card_all %>% ggplot(aes(x = card)) +
geom_bar() +
geom_text(aes(label = ..count..), stat = "count", vjust = -0.2, colour = 'black') +
labs(title = 'Anzahl Konten mit Karte',
subtitle = paste0("Anzahl Observationen = ", nrow(df_card_all)),
x = 'Karte',
y = 'Anzahl Konten'
)
80 % aller Konten bei der Bank sind mit besitzen eine Karte. Eine nächste Analyse zeigt, die Verteilung, welche Kartenttypen häufig besitzt werden.
df_card_all %>%
filter(card == 'yes') %>%
ggplot(aes(x = card_type)) +
geom_bar() + geom_text(aes(label = ..count..), stat = "count", vjust = -0.2, colour = 'black') +
labs(title = 'Anzahl Kunden pro Kartentyp',
subtitle = paste0("Anzahl Observationen = 892"),
x = 'Karte',
y = 'Anzahl Konten'
)
Bei Kunden die eine Karte besitzen, kommt die classic-Karte am höufigsten vor. Beinahe 3/4 der Kunden besitzen diese Karte. 16 % besitzen eine junior-Karte und knapp 10 % eine gold-Karte.
5.4.2 Entwicklung Anzahl Karten
df_dev_card_gender <- df_card_all %>%
filter(card == 'yes') %>%
group_by(issued_date, gender, card_type) %>%
count(issued_date) %>%
ungroup() %>%
mutate(
added_n = cumsum(n),
year = year(issued_date),
year = as_factor(year)
)
df_dev_card_gender %>% ggplot(aes(x = issued_date, y = added_n)) + geom_line(size = 1, color = 'gray37') +
labs(title = 'Anzahl neuer Karten pro Monat',
subtitle = paste0("Anzahl Observationen = ", nrow(card)),
x = 'Zeit',
y = 'Anzahl Karten'
)
Die Anzahl der besitzten Karten steigt über die Zeit deutlich an. Die Kurve hat schon fast einen exponentiellen Verlauf. Die Abflachung der Kurve der Entwicklung der Anzahl Konten zwischen Anfang 1994 und Ende 1995 ist ist bei den Karten nicht erkennbar.
df_dev_card_gender %>% ggplot(aes(x = issued_date, fill = card_type)) +
geom_histogram(bins = 30) +
facet_wrap(~card_type) +
labs(title = 'Anzahl neuer Karten pro Monat',
subtitle = paste0("Anzahl Observationen = ", nrow(card)),
x = 'Zeit',
y = 'Anzahl Karten',
fill = 'Kartentyp'
)
Der eher exponentielle Verlauf über alle Kartentypen spiegelt sich nicht überall wieder. Der Kartentyp junior entwickelt sich linear. classic-Karten entwickeln sich sehr stark, die Kurve ist eher exponentiell bis quadratisch. Die Entwicklung der gold-Karten ist am ehesten exponentiell.
5.4.3 Verteilung Alter
df_card_all %>%
filter(card == 'yes') %>%
ggplot(aes(x = card_type, y = age, fill = gender)) +
geom_boxplot() +
labs(title = 'Altersverteilung nach Kartentyp',
subtitle = paste0("Anzahl Observationen = ", nrow(card)),
x = 'Kartentyp',
y = 'Alter',
fill = 'Geschlecht'
)
Junior-Karten werden von Personen unter 20 Jahren bezogen. Es gibt einen Ausreisser mit ca. 25 Jahren. 1.5 mal die Länge der “Box” des Boxplot, wird toleriert, alsdass diese Kunden noch nicht als Ausreisser gelten.
Die Altersverteilung von Kunden mit classic- oder gold-Karte ist relativ ähnlich. Männliche Kunden mit einer gold-Karte sind eher etwas älter. Das Geschlecht hat keinen relevanten Einfluss.
5.4.4 Entwicklung des Vermögens
5.4.4.1 Karte vs. keine Karte
df_trans_card_all %>%
ggplot(aes(x = cardtype_last_date, y = med_cardtype_balance, color = card)) +
geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit Karte vs. ohne Karte',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_card_all)),
x = 'Zeit',
y = 'Vermögen (Median)',
color = 'Karte vorhanden'
)
Die Entwicklung des Besitzes einer Karte wirkt sich positiv auf die Entwicklung des Vermögens aus. Dies wurde bereits im vorherigen Kapitel aus dem Vergleich der einzelnen Produkttypen sichtbar. So sind alle Produkttypen die eine Karte beinhalten in Gruppe 1.
5.4.4.2 Unterschiedliche Kartentypen
df_trans_card_all %>%
filter(card == 'yes') %>%
ggplot(aes(x = cardtype_last_date, y = med_cardtype_balance, color = card_type)) +
geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit Karte vs. ohne Karte',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_card_all)),
x = 'Zeit',
y = 'Vermögen (Median)',
color = 'Kartentyp'
)
Während sich Kunden mit einer junior- und classic-Karte ähnlich positiv entwickeln, heben sich Kunden mit einer gold-Karte nochmals deutlich davon ab.
5.4.5 Vermögen zum Zeitpunkt des Kartenbezugs
In der Abbildung ist jedoch die Höhe des Vermögens zum Zeitpunkt des Kartenbezugs nicht erkennbar. Aus den vorhergehenden Abbildungen ist erkennbar, dass gold-Karten vorallem ab 1997 bezogen wurden. Zu diesem Zeitpunkt war das Vermögen dieser Kunden schon deutlich höher als das der Kunden mit anderen Kartentyen.
df_cardorder_change %>%
ggplot(aes(x = balance_start, fill = card_type)) +
geom_density(alpha = 0.4) +
labs(title = 'Vermögen direkt vor dem Kartenbezug',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_card_all)),
x = 'Vermögen CZK',
y = 'Dichte',
fill = 'Kartentyp'
)
Die Abbildung bestätigt die Vermutung. gold-Kunden haben zum Zeitpunkt des Kartenbezugs ein deutlich höheres Vermögen. Die Kurve ist allerdings sehr flach, es gibt also einige Kunden mit einem ähnlichen Vermögen wie Bezüger von junior- und classic-Karten.
Das Vermögen von junior-Kartenkunden ist am tiefsten. Das ist naheliegend, da diese Kunden um die 20 Jahre alt sind. Einige jüngere Kunden haben aber bereits ein ähnliches Vermögen wie classic-Kunden. Möglicherweise unterscheiden sich hier junge Kunden, die ein Studium besucht haben gegenüber Kunden die eine Lehre absolviert haben und mit 20 Jahren bereits voll berufstätig sind. Das Bildungssymstem in Tschechien gleicht dem der Schweiz sehr stark.
Die Kurve von classic-Kartenkunden ist am steilsten und streut deshalb am wenigsten.
5.5 Kredit vs. kein Kredit
5.5.1 Anzahl Konten mit Krediten
df_loan_all %>%
ggplot(aes(x = loan)) +
geom_bar() +
geom_text(aes(label = ..count..), stat = "count", vjust = -0.2, colour = 'black') +
labs(title = 'Anzahl Konten mit Kredit',
subtitle = paste0("Anzahl Observationen = ", nrow(df_loan_all)),
x = 'Kredit',
y = 'Anzahl Konten'
)
Fast 85 % aller Konten bei der Bank haben einen Kredit aufgenommen. Die nächste Analyse zeigt die Aufteilung nach Kreditstatus.
df_loan_all %>%
filter(loan == 'yes') %>%
ggplot(aes(x = loan_status)) +
geom_bar() +
geom_text(aes(label = ..count..), stat = "count", vjust = -0.2, colour = 'black') +
labs(title = 'Anzahl Kunden pro Kreditstatus',
subtitle = paste0("Anzahl Observationen = 682"),
x = 'Kreditstatus',
y = 'Anzahl Konten'
)
Von den 692 Krediten ist 1/3 bereits beendet, während 2/3 noch laufen.
5.5.2 Entwicklung Anzahl Loans
df_dev_loan_gender <- df_loan_all %>%
filter(loan == 'yes') %>%
group_by(loan_date, gender, duration) %>%
count(loan_date) %>%
ungroup() %>%
mutate(
added_n = cumsum(n),
year = year(loan_date),
year = as_factor(year)
)
df_dev_loan_gender %>% ggplot(aes(x = loan_date, y = added_n)) + geom_line(size = 1, color = 'gray37') +
labs(title = 'Anzahl neuer Kredite pro Monat',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Zeit',
y = 'Anzahl Kredite'
)
Die Anzahl der Kredite steigt über die Zeit linear an.
Die Abflachung der Kurve der Entwicklung der Anzahl Konten zwischen Anfang 1994 und Ende 1995 ist ist bei den Krediten, wie schon bei den Karten, nicht erkennbar. Ab 1997 steigt die Vergabe von neuen Kredit erneut an.
df_dev_loan_gender %>%
ggplot(aes(x = loan_date)) +
geom_density() +
facet_wrap(~ duration) +
labs(title = 'Anzahl neuer Kredite pro Monat, aufgeteilt nach Laufzeit (in Monaten)',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Zeit',
y = 'Anzahl Kredite',
)
Die Kurven von Krediten mit kürzerer Laufzeit (12 und 24 Monate) ähneln einander, während es Kredite mit einer längeren Laufzeit tun. Zwischen 1995 und 1997 ist ein Rückgang von Krediten mit kürzeren Laufzeiten erkennbar, während die Vergabe dieser Kredite nachher aber wieder stark ansteigt. Kredite mit längerer Laufzeit nehmen je länger je mehr zu gegenüber Krediten mit kürzerer Laufzeit. Die Höchstwert sind im Jahr 1997.
5.5.3 Verteilung Dauer, Alter, Geschlecht
df_loan_all %>%
filter(loan == 'yes') %>%
ggplot(aes(x = age, fill = gender)) +
geom_density(alpha = 0.4) +
facet_wrap(~ duration) +
labs(title = 'Altersverteilung nach Laufzeit',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Alter',
y = 'Dichte'
)
Die Altersverteilung nach Laufzeit ist unterschiedlich. Generell sind Kunden die einen Kredit beanspruchen, zwischen 20 und 60 Jahre alt. Möglicherweise ist ein regelmässiges Salär eine Bedingung für eine Kreditvergabe.
Jüngere Kunden beantragen eher Kredite mit mittlerer Laufzeit (24, 36 oder 48 Monate). Ältere Kunden tendieren eher zu sehr kurzen oder sehr langen Laufzeiten (12 oder 60 Monate). Eine mögliche Erklärung dafür ist, dass ältere Kunden entweder ein höheres regelmässiges Einkommen haben und so auch grössere monatliche Rückzahlungen stemmen können. Andererseits spricht für eine lange Laufzeit tiefe Rentenzahlungen und somit möglicherweise wenig finanzielle Ressourcen um einen Kredit abzuzahlen.
Das Geschlecht hat vorallem auf Kredite mit einer mittleren Laufzeit (36 Monate) einen Einfluss.
Die effektiven Zahlen zeigt folgende Visualisierung.
df_loan_all %>%
filter(loan == 'yes') %>%
ggplot(aes(x = duration, fill = gender)) +
geom_bar() +
facet_wrap(~ gender) +
geom_text(aes(label = ..count..), stat = "count", vjust = -0.2, colour = 'black') +
labs(title = 'Geschlechterverteilung nach Laufzeit',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Laufzeit',
y = 'Anzahl Kunden',
fill = 'Geschlecht'
)
5.5.4 Status der Kredite
5.5.4.1 Verteilung nach laufende und abgeschlossene Kredite
df_loan_all %>%
filter(loan == 'yes') %>%
ggplot(aes(x = loan_status, fill = status)) +
geom_bar(position = 'dodge') +
geom_text(aes(label = ..count..), stat = "count", position = position_dodge(width = 1), vjust = -0.2, colour = 'black') +
labs(title = 'Anzahl Kredite pro Status',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Kreditstatus',
y = 'Anzahl Kredite',
fill = 'Status'
)
OK so far und no problems werden als positive Status gewertet. Client in debt und loan not payed als negativ. Nur 10 % der laufenden und 13 % der abgeschlossenen Kredite haben einen negativen Status.
df_loan_all %>%
filter(loan == 'yes') %>%
ggplot(aes(x = loan_status, fill = status)) +
geom_bar(position = 'dodge') +
facet_wrap(~ duration) +
geom_text(aes(label = ..count..), stat = "count", position = position_dodge(width = 1), vjust = -0.2, colour = 'black') +
labs(title = 'Anzahl Kredite pro Status, aufgeteilt nach Laufzeit',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Kreditstatus',
y = 'Anzahl Kredite',
fill = 'Status'
)
df_loan_all %>%
filter(loan == 'yes') %>%
ggplot(aes(x = duration, fill = loan_status)) +
geom_bar(position = 'dodge') +
geom_text(aes(label = ..count..), stat = "count", position = position_dodge(width = 1), vjust = -0.2, colour = 'black') +
labs(title = 'Anzahl Kredite pro Status, aufgeteilt nach Laufzeit',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Kreditstatus',
y = 'Anzahl Kredite',
fill = 'Status'
)
Eine weiterführende Analyse der Status ergibt, dass Kredite mit längerer Laufzeit häufiger einen negativen Status aufweisen. Bei abgeschlossenen Krediten sind es häufig diejenigen mit kürzerer Laufzeit.
5.5.4.2 Einfluss Kredithöhe auf den Status
df_loan_all %>%
filter(loan == 'yes') %>%
ggplot(aes(x = status, y = loan_amount, fill = loan_status)) +
geom_boxplot() +
labs(title = 'Verteilung Kredithöhe pro Status, aufgeteilt nach Kreditstatus',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Status',
y = 'Kredithöhe',
fill = 'Kreditstatus'
)
df_loan_all %>%
mutate(
pay_stat = case_when(
status == 'client in debt' ~ 'negative',
status == 'loan not payed' ~ 'negative',
TRUE ~ 'positive'
)
) %>%
ggplot(aes(x = loan_amount, fill = pay_stat)) +
geom_density(alpha = 0.4) +
labs(title = 'Distribution of loan amount divided by payment status',
subtitle = 'Observation range: All clients with a loan from 1993 - 1998',
x = 'Assets (Czech Crowns)',
y = 'Density',
fill = 'Credit payment status'
)## Warning: Removed 3818 rows containing non-finite values (stat_density).
Neben der Laufzeit scheint auch die Kredithöhe den Status zu beeinflussen. Laufende Kredite sind deutlich höher als abgeschlossene.
Bei den abgeschlossenen Kreditstatus gibt es einige Ausreisser bei denjenigen, die ohne Probleme beendet wurden. Die durschnittliche Kredithöhe ist unabhängig vom Status.
Bei noch laufenden Krediten weisen die mit dem höheren Kreditbetrag eher einen negativen Status auf.
5.5.4.3 Altersverteilung
Für die Berechnung des Alters bei Krediten die bereits abgeschlossen sind, wurde vom aktuellen Alter der Kunden die vergangene Zeit seit Kreditende abgezogen. Die Analyse wäre sonst verzerrt, indem die Altersverteilung von abgeschlossenen Krediten immer zu hoch wäre.
df_loan_all %>%
filter(status == 'client in debt' | status == 'loan not payed') %>%
mutate(
age = ifelse(status == 'client in debt', age, age-loan_diff_time_loanstatus)
) %>%
ggplot(aes(x = age, color = status)) +
geom_density(size = 1) +
labs(title = 'Altersverteilung von negativen Status',
x = 'Alter',
y = 'Dichte',
fill = 'Status'
)
Bei laufenden Krediten sind jüngere Kunden für die negativen Status verantwortlich. Dies ist eher erstaunlich. Vorhergehende Analysen haben gezeigt, dass der Status client in debt vorallem bei Krediten mit längerer Laufzeit vorkommen. Kredite mit längerer Laufzeit werden aber eher von älteren Kunden bezogen.
Bei abgeschlossenen Krediten haben die älteren Kunden den negativen Status zu verantworten. Dieser Status kommt häufiger bei Krediten mit kürzerer Laufzeit vor. Kredite mit kürzerer Laufzeit werden häufiger von älteren Menshen bezogen.
df_loan_all %>%
filter(status == 'client in debt' | status == 'loan not payed') %>%
ggplot(aes(x = age, fill = account_type)) +
geom_density() +
facet_wrap(~status) +
labs(title = 'Altersverteilung von negativen Status',
x = 'Alter',
y = 'Dichte',
fill = 'Kontotyp'
)
df_loan_all %>%
filter(status == 'OK so far' | status == 'no problems') %>%
mutate(
age = ifelse(status == 'OK so far', age, age-loan_diff_time_loanstatus)
) %>%
ggplot(aes(x = age, color = status)) +
geom_density(size = 1) +
labs(title = 'Altersverteilung von positiven Status',
x = 'Alter',
y = 'Dichte',
fill = 'Status'
)
Laufende und abgeschlossene Kredite mit positivem Status haben eine sehr ähnliche Altersverteilung.
5.5.5 Verteilung Kredithöhe, Alter und Geschlecht
df_loan_all %>%
filter(loan == 'yes') %>%
ggplot(aes(x = age, y = loan_amount, color = gender)) +
geom_smooth() +
labs(title = 'Kredithöhe nach Alter',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Alter',
y = 'Kredithöhe',
color = 'Geschlecht'
)## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
Die Kredithöhe ist erstaunlich ähnlch verteilt nach Alter. Auch das Geschlecht hat keinen Einfluss.
5.5.6 Beziehung Kredithöhe und monatliche Rückzahlungen
df_loan_all %>%
filter(loan == 'yes') %>%
ggplot(aes(x = loan_amount, y = payments, color = duration)) +
geom_point() +
labs(title = 'Beziehung Kredithöhe und monatliche Rückzahlungen',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Kredithöhe',
y = 'Monatliche Rückzahlungen',
color = 'Laufzeit'
)
Diese Analyse ist absolut faszinierend. Bei einer ersten Überlegung scheine eine lineare Beziehung zwischen Kredithöhe und monatlichen Rückzahlungen logisch. Es bedeutet, dass die monatlichen Rückzahhlungen abhängig sind von der Laufzeit und der Kredithöhe. Nicht aber von Kundencharakteristiken wie Alter, Geschlecht und zum Beispiel, ob ein Konto gemeinsam geführt wird.
df_loan_all %>%
filter(loan == 'yes') %>%
ggplot(aes(x = loan_date, y = loan_amount, color = gender)) +
geom_point() +
geom_smooth() +
labs(title = 'Entwicklung Kredithöhe über Zeit',
subtitle = paste0("Anzahl Observationen = ", nrow(loan)),
x = 'Zeit',
y = 'Kredithöhe',
color = 'Geschlecht'
)## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
Über den Zeitraum 1993 bis Ende 1998 ist die Höhe der Kreditvergabe nur ganz leicht angestiegen.
5.5.7 Entwicklung des Vermögens
5.5.7.1 Kredit vs. keine Kredit
df_trans_loan_all %>%
ggplot(aes(x = loanduration_last_date, y = med_loanduration_balance, color = loan)) +
geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit Kredit vs. ohne Kredit',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_loan_all)),
x = 'Zeit',
y = 'Vermögen (Median)',
color = 'Kredit vorhanden'
)
Die Entwicklung des Besitzes eines Kredits wirkt sich positiv auf die Entwicklung des Vermögens aus, auch wenn nicht so stark wie bei Karten. Dies wurde bereits im vorherigen Kapitel aus dem Vergleich der einzelnen Produkttypen sichbar. Im Gegensatz zu Karten sind Produkttypen die nur einen Kredit beinhalten eher in Gruppe 2.
5.5.7.2 Auswirkung von Laufzeiten
df_trans_loan_all %>%
filter(!is.na(duration)) %>%
ggplot(aes(x = loanduration_last_date, y = med_loanduration_balance, color = duration)) +
geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit Kredit nach Laufzeit',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_loan_all)),
x = 'Zeit',
y = 'Vermögen (Median)',
color = 'Laufzeit'
)
Unterschiedliche Laufzeiten haben keinen Einfluss auf die Entwicklung.
5.5.7.3 Positive und negative Status
df_trans_loan_all %>%
filter(!is.na(duration)) %>%
ggplot(aes(x = Loan_status_last_date, y = med_loan_status_balance, color = status)) +
geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit Kredit nach Status',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_loan_all)),
x = 'Zeit',
y = 'Vermögen (Median)',
color = 'Status'
)
Es ist deutlich erkennbar, dass sich Kredite mit positivem Status besser entwickeln.
5.5.8 Vermögen zum Zeitpunkt des Kreditbezugs
In den Abbildungen ist die Höhe des Vermögens zum Zeitpunkt des Kreditbezugs nicht erkennbar.
df_loanorder_change %>%
ggplot(aes(x = balance_start, fill = status)) +
geom_density(alpha = 0.4) +
labs(title = 'Vermögen direkt vor dem Kreditbezug',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_loan_all)),
x = 'Vermögen CZK',
y = 'Dichte',
fill = 'Status'
)
Die Kurven ähneln sich stark. Kunden mit negativem Status hatten bei der Kreditvergabe ein tieferes Vermögen, als Kunden von Krediten mit positivem Status.
Zusätzlich beobachtbar ist, dass Kunden mit einem negativen Status und heute noch laufenden Kredit noch einmal ein tieferes Vermögen aufweisen, als die von abgeschlossenen Krediten. Aus vorhergehenden Analysen ist erkennbar, dass die Kredithöhe von Krediten mit Status client in debt am höchsten sind. Es scheint, dass nicht nur die Bedingungen für eine Kreditvergabe gelockert wurden, sondern gleichzeitig auch die gewährte Kreditsumme erhöht wurde.
df_loanorder_change %>%
ggplot(aes(x = balance_start, fill = duration)) +
geom_density(alpha = 0.4) +
labs(title = 'Vermögen direkt vor dem Kreditbezug',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_loan_all)),
x = 'Vermögen CZK',
y = 'Dichte',
fill = 'Laufzeit'
)
Das Vermögen scheint keinen Einfluss darauf zu haben, für welche Laufzeit des Kredits sich ein Kunde entscheidet.
5.5.9 Grosse Einnahme/Ausgaben direkt nach Kreditvergabe
In der folgenden Analyse sind nur Zahlungen von Kunden berücksichtigt, die auch tatsächlich einen Kredit bezogen. In diesem Kapitel wird analysiert, wie schnell nach Kreditvergabe die Kreditsumme auf das Konto gutgeschrieben und danach wieder belastet wird.
df_credit_loan2 <- df_trans_loan_all %>%
filter(loan == 'yes' & trans_type == 'credit' & trans_date > loan_date & trans_date < end_date & trans_amount > 0.99*loan_amount) %>%
mutate(
month_diff = floor(interval(loan_date, trans_date) / months(1))
)
df_credit_loan2 %>%
ggplot(aes(x = month_diff, y = trans_amount, color = duration)) +
geom_point(alpha = 0.7) +
labs(title = 'Gutschriften in Kredithöhe nach Erhalt des Kredits',
x = 'Zeit in Monaten nach Kreditbezug',
y = 'Zahlungssumme',
color = 'Laufzeit'
)
Gutschriften in Kredithöhe gibt es auf den Konten mit einem Kredit direkt nach Ausstellung mehrere. Dabei ist erstaunlich, dass sich diese über eine langen Zeitraum strecken. Kredite werden innerhalb der ersten 3 Jahre nach Kreditbezug ausgestellt. Kredite mit einer kürzeren Laufzeit werden noch innerhalb der Laufzeit überwiesen.
df_credit_loan <- df_trans_loan_all %>%
filter(loan == 'yes' & trans_type == 'credit' & trans_date > loan_date & trans_date < end_date & trans_amount == loan_amount) %>%
mutate(
month_diff = floor(interval(loan_date, trans_date) / months(1))
)
df_credit_loanBelastungen in der Höhe der Kreditsumme gibt es keine.
df_withdrawal_loan <- df_trans_loan_all %>%
filter(loan == 'yes' & trans_type == 'withdrawal' & trans_date > loan_date & trans_date < end_date & trans_amount > 0.8*loan_amount) %>%
mutate(
month_diff = floor(interval(loan_date, trans_date) / months(1))
)
df_withdrawal_loan %>%
ggplot(aes(x = month_diff, y = trans_amount, color = duration)) +
geom_point(alpha = 0.7) +
labs(title = 'Belastungen in Kredithöhe nach Erhalt des Kredits',
x = 'Zeit in Monaten nach Kreditbezug',
y = 'Zahlungssumme',
color = 'Laufzeit'
)
Es gibt jedoch Zahlungen in der Höhe von etwa 80% der Kreditsumme. Das lässt darauf schliessen, dass in der Kreditsumme Reserven eingerechnet sind oder für die Ausstellung des Kredits Spesen zu bezahlen sind, die bereits bei der Ausstellung des Kredits in Abzug gebracht wurden.
5.6 Dauerauftrag vs. keine Dauerauftrag
ke### Anzahl Konten mit Dauerauftrag
df_order_all %>%
group_by(account_id) %>%
summarise_all(last) %>%
ggplot(aes(x = order)) +
geom_bar() +
geom_text(aes(label = ..count..), stat = "count", vjust = -0.2, colour = 'black') +
labs(title = 'Anzahl Konten mit Dauerauftrag',
subtitle = paste0("Anzahl Observationen = ", nrow(df_loan_all)),
x = 'Dauerauftrag',
y = 'Anzahl Konten'
)
84 % aller Konten bei der Bank haben auch Daueraufträge. Eine nächste Analyse zeigt, die Verteilung der unterschiedlichen Gründe für Daueraufträge.
df_order_all %>%
filter(order == 'yes') %>%
ggplot(aes(x = order_character)) +
geom_bar() +
geom_text(aes(label = ..count..), stat = "count", vjust = -0.2, colour = 'black') +
labs(title = 'Anzahl Konten mit Dauerauftrag',
subtitle = paste0("Anzahl Observationen = ", nrow(df_loan_all)),
x = 'Dauerauftrag',
y = 'Anzahl Konten'
)
5.6.1 Entwicklung Anzahl Order
Es ist nicht möglich, die Entwicklung der Anzahl Daueraufträge zu bestimmen, da diese kein Datum besitzen.
5.6.2 Verteilung Alter, Charakter, Geschlecht
df_order_all %>%
filter(order == 'yes') %>%
ggplot(aes(x = age, color = gender)) +
geom_density() +
facet_wrap(~ order_character) +
labs(title = 'Anzahl Konten mit Dauerauftrag',
subtitle = paste0("Anzahl Observationen = ", nrow(df_loan_all)),
x = 'Alter',
y = 'Dichte',
color = 'Geschlecht'
)
Ältere Menschen haben kaum Daueraufträge. Nur Daueraufträge für den Haushalt werden auch von älteren Personen erfasst. Die Altersverteilung für die anderen Gründe sind sich sehr ähnlich. Beim Leasing würde man vielleicht jüngere Männer erwarten, so erstaunt es, dass sogar eine Anomalie bei Frauen von ca. 55 Jahren erkennbar ist.
5.6.3 Entwicklung des Vermögens
df_trans_order_all %>%
ggplot(aes(x = order_last_date, y = med_order_balance, color = order)) +
geom_line() +
labs(title = 'Entwicklung des Kontostandes von Kunden mit Daueraufträgen vs. keine Daueraufträge',
subtitle = paste0("Anzahl Observationen = ", nrow(df_trans_loan_all)),
x = 'Zeit',
y = 'Vermögen (Median)',
color = 'Dauerauftrag vorhanden'
)
6 Client Analytical Record
Im Hinblick auf ein Folgeprojekt wird in diesem Absatz der Client Analytical Record vorgestellt. Dieser enthält alle Kunden.
client_analytical_record_help <- df_trans_products_all %>%
select(trans_date, client_id, account_id, balance, account_date, account_type, gender, age, district_client, product, product_type, order, loan, loan_status, status, loan_date, end_date, loan_amount, payments, card, issued_date, card_type) %>%
group_by(account_id) %>%
arrange(trans_date) %>%
summarise_all(last) %>%
ungroup() %>%
select(-trans_date)
client_analytical_record <- client_analytical_record_help %>%
right_join(df_account_disp_client, by = 'client_id') %>%
rename(
account_id = account_id.x,
account_date = account_date.x,
account_type = account_type.x,
gender = gender.x,
age = age.x,
district_client = district_client.x,
) %>%
select(-account_id.y, -district_account, -frequency, -account_date.y, -account_type.y, -disp_id, -disp_type, -account_type.y, -district_client.y, -gender.y, -age.y, -age_grouped, -age_grouped_desc) %>%
arrange(account_id)
client_analytical_record7 Entscheidungsbaum
set.seed(11)
client_analytical_record_help_splittedDataSet <-initial_split(client_analytical_record_help, prop=0.8)
client_analytical_record_help_trainDataset <- training(client_analytical_record_help_splittedDataSet)
client_analytical_record_help_testDataset <- testing(client_analytical_record_help_splittedDataSet)
manipulated_row <- client_analytical_record_help_trainDataset[nrow(client_analytical_record_help_trainDataset),]
#minichallenge_titanic_trainDataset = add_row(minichallenge_titanic_trainDataset, manipulated_row)
model0 <- product~ + age
fit0 <- rpart(model0, data=client_analytical_record_help_trainDataset,
control = rpart.control(minsplit = 1,
minbucket = 1,
cp = 0.01))
fancyRpartPlot(fit0, caption = NULL)
fit <- rpart(product~., data=client_analytical_record_help_trainDataset, method="class")
fancyRpartPlot(fit, caption = NULL)
t_pred <- as_data_frame(predict(fit, client_analytical_record_help_testDataset, "class"))## Warning: `as_data_frame()` was deprecated in tibble 2.0.0.
## Please use `as_tibble()` instead.
## The signature and semantics have changed, see `?as_tibble`.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.t <- client_analytical_record_help_testDataset["product"]
accuracy <- sum(t_pred == t) / nrow(t)
print(accuracy)## [1] 1# #no card
# df_dev_nocard_all <- df_trans_card_all %>%
# filter(card == 'no' & account_date > '1994-07-01' & account_date < '1995-06-30') %>%
# select(-gender, -age) %>%
# distinct() %>%
# arrange(trans_id, account_id, trans_date) %>%
# group_by(account_id, trans_date) %>%
# summarise_all(last)
#
# df_dev_nocard_summarise <- df_dev_nocard_all %>%
# group_by(trans_date) %>%
# summarise(
# avg = mean(balance),
# med = median(balance)
# )
#
# df_dev_nocard <- left_join(df_dev_nocard_all, df_dev_nocard_summarise, by = 'trans_date')
#
# #card, but no card_type difference
# df_dev_yescard_all <- df_trans_card_all %>%
# filter(card == 'yes' & issued_date > '1997-01-01' & issued_date < '1998-01-01') %>%
# select(-gender, -age) %>%
# distinct() %>%
# arrange(trans_id, account_id, trans_date) %>%
# group_by(account_id, trans_date) %>%
# summarise_all(last)
#
# df_dev_yescard_summarise <- df_dev_yescard_all %>%
# group_by(trans_date) %>%
# summarise(
# avg = mean(balance),
# med = median(balance)
# )
#
# df_dev_yescard <- left_join(df_dev_yescard_all, df_dev_yescard_summarise, by = 'trans_date')
#
# #merge
# df_dev_card_yesno <- bind_rows(df_dev_yescard, df_dev_nocard)# df_dev_card_yesno %>% ggplot(aes(x = trans_date, y = avg, color = card)) + geom_line()
# df_dev_card_yesno %>% ggplot(aes(x = trans_date, y = med, color = card)) + geom_line()
# df_dev_card_yesno %>% ggplot(aes(x = trans_date, y = avg, color = card)) + geom_point(alpha = 0.05) + geom_smooth()
# df_dev_card_yesno %>% ggplot(aes(x = trans_date, y = med, color = card)) + geom_point(alpha = 0.05) + geom_smooth()# #gold card
# df_dev_goldcard_all <- df_trans_card_all %>%
# filter(card_type == 'gold' & issued_date > '1997-01-01' & issued_date < '1998-01-01') %>%
# select(-gender, -age) %>%
# distinct() %>%
# arrange(trans_id, account_id, trans_date) %>%
# group_by(account_id, trans_date) %>%
# summarise_all(last)
#
# df_dev_goldcard_summarise <- df_dev_goldcard_all %>%
# group_by(trans_date) %>%
# summarise(
# avg = mean(balance),
# med = median(balance)
# )
#
# df_dev_goldcard <- left_join(df_dev_goldcard_all, df_dev_goldcard_summarise, by = 'trans_date')
#
# #classic card
# df_dev_classiccard_all <- df_trans_card_all %>%
# filter(card_type == 'classic' & issued_date > '1997-01-01' & issued_date < '1998-01-01') %>%
# select(-gender, -age) %>%
# distinct() %>%
# arrange(trans_id, account_id, trans_date) %>%
# group_by(account_id, trans_date) %>%
# summarise_all(last)
#
# df_dev_classiccard_summarise <- df_dev_classiccard_all %>%
# group_by(trans_date) %>%
# summarise(
# avg = mean(balance),
# med = median(balance)
# )
#
# df_dev_classiccard <- left_join(df_dev_classiccard_all, df_dev_classiccard_summarise, by = 'trans_date')
#
# #junior card
# df_dev_juniorcard_all <- df_trans_card_all %>%
# filter(card_type == 'junior' & issued_date > '1997-01-01' & issued_date < '1998-01-01') %>%
# select(-gender, -age) %>%
# distinct() %>%
# arrange(trans_id, account_id, trans_date) %>%
# group_by(account_id, trans_date) %>%
# summarise_all(last)
#
# df_dev_juniorcard_summarise <- df_dev_juniorcard_all %>%
# group_by(trans_date) %>%
# summarise(
# avg = mean(balance),
# med = median(balance)
# )
#
# df_dev_juniorcard <- left_join(df_dev_juniorcard_all, df_dev_juniorcard_summarise, by = 'trans_date')
#
# #merge
# df_dev_card_type <- bind_rows(df_dev_goldcard, df_dev_classiccard, df_dev_juniorcard, df_dev_nocard)# #generate sampled sublset of clients with no card
# df_trans_card_no <- df_trans_card_all %>%
# filter(card == 'no' & account_date < '1997-11-01')
#
# df_trans_card_no_sub <- df_trans_card_all %>%
# filter(card == 'no' & account_date < '1997-11-01') %>%
# group_by(account_id) %>%
# count(account_id) %>%
# ungroup() %>%
# sample_n(10) %>%
# mutate(
# added_n = cumsum(n)
# )
# total_no <- df_trans_card_no_sub$added_n[10]
#
# df_trans_card_no_sub <- df_trans_card_no_sub[,1]
# df_trans_card_no <- left_join(df_trans_card_no_sub, df_trans_card_no, by = 'account_id')
# df_trans_card_no_sample <- df_trans_card_no %>% sample_n(total_no)
#
# #generate sampled subset of clients with card
# df_trans_card_yes <- df_trans_card_all %>%
# filter(issued_date > '1997-11-01' & issued_date < '1998-01-01')
#
# df_trans_card_yes_sub <- df_trans_card_all %>%
# filter(issued_date > '1997-11-01' & issued_date < '1998-01-01') %>%
# group_by(account_id) %>%
# count(account_id) %>%
# ungroup() %>%
# sample_n(10) %>%
# mutate(
# added_n = cumsum(n)
# )
# total_yes <- df_trans_card_yes_sub$added_n[10]
#
# df_trans_card_yes_sub <- df_trans_card_yes_sub[,1]
# df_trans_card_yes <- left_join(df_trans_card_yes_sub, df_trans_card_yes, by = 'account_id')
# df_trans_card_yes_sample <- df_trans_card_yes %>% sample_n(total_yes)
#
# #combine subsets clients with no card and clients with card
# df_trans_card_all_sample <- bind_rows(df_trans_card_no_sample, df_trans_card_yes_sample, .id = NULL)# #plot
# df_trans_card_all_sample %>% ggplot(aes(x = trans_date, y = balance, color = card)) + geom_point(alpha = 0.1) + geom_smooth() +
# geom_vline(xintercept = ymd('1997-12-01'), color = 'gray37') +
# geom_text(mapping = aes(x = ymd('1997-12-01'), y = 0, label = "1997-12-01"), color = "gray37", hjust = -0.1, vjust = 1)# #analyse the difference between balance of last transaction before got a card and 31.12.1998
# #clients with card
# df_trans_card_yes_sample_diff_start <- df_trans_card_yes_sample %>%
# filter(trans_date <= issued_date) %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_start = balance
# )
#
# df_trans_card_yes_sample_diff_start <- df_trans_card_yes_sample_diff_start[!duplicated(df_trans_card_yes_sample_diff_start$account_id,fromLast=TRUE),]
#
# df_trans_card_yes_sample_diff_end <- df_trans_card_yes_sample %>%
# filter(trans_date == '1998-12-31') %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_end = balance
# )
#
# df_trans_card_yes_sample_diff_end <- df_trans_card_yes_sample_diff_end[!duplicated(df_trans_card_yes_sample_diff_end$account_id,fromLast=TRUE),]
#
# #combine subsets of clients with card
# df_trans_card_yes_change <- full_join(df_trans_card_yes_sample_diff_start, df_trans_card_yes_sample_diff_end, by = 'account_id')
#
# #clients with no card
# df_trans_card_no_sample_diff_start <- df_trans_card_no_sample %>%
# filter(trans_date <= '1997-11-01') %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_start = balance
# )
#
# df_trans_card_no_sample_diff_start <- df_trans_card_no_sample_diff_start[!duplicated(df_trans_card_no_sample_diff_start$account_id,fromLast=TRUE),]
#
# df_trans_card_no_sample_diff_end <- df_trans_card_no_sample %>%
# filter(trans_date == '1998-12-31') %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_end = balance
# )
#
# df_trans_card_no_sample_diff_end <- df_trans_card_no_sample_diff_end[!duplicated(df_trans_card_no_sample_diff_end$account_id,fromLast=TRUE),]
#
# #combine subsets of clients with no card
# df_trans_card_no_change <- full_join(df_trans_card_no_sample_diff_start, df_trans_card_no_sample_diff_end, by = 'account_id')
#
# #combine subsets clients with no card and clients with card
# df_trans_card_change_all <- bind_rows(df_trans_card_yes_change, df_trans_card_no_change, .id = NULL)
# df_trans_card_change_all <- df_trans_card_change_all %>%
# select(-card_type.y, -card.y) %>%
# rename(
# card_type = card_type.x,
# card = card.x,
# trans_date_start = trans_date.x,
# trans_date_end = trans_date.y
# ) %>%
# mutate(
# diff_end_start = balance_end / balance_start,
# change = case_when(
# diff_end_start <= 0.9 ~ 'negative',
# diff_end_start <= 1.1 ~ 'same',
# diff_end_start <= 1.5 ~ '1.5',
# diff_end_start <= 2 ~ 'doubled',
# TRUE ~ 'more'
# )
# )
#
# df_trans_card_change_all$change <-
# ordered(df_trans_card_change_all$change, levels = c('negative', 'same', '1.5', 'doubled', 'more'))
#
# #plot
# df_trans_card_change_all %>% ggplot(aes(x = change, fill = card)) + geom_bar() + facet_wrap(~ card)# df_trans_card_ex <- df_trans_card_all %>%
# filter(
# account_id == 7753 | account_id == 576
# )
#
# df_trans_card_ex %>% ggplot(aes(x = trans_date, y = balance, color = card)) + geom_line() + geom_point()# #generate sampled subset of clients with no card
# df_trans_card_no2 <- df_trans_card_all %>%
# filter(card == 'no' & account_date < '1997-04-01')
#
# df_trans_card_no_sub2 <- df_trans_card_all %>%
# filter(card == 'no' & account_date < '1995-04-01') %>%
# group_by(account_id) %>%
# count(account_id) %>%
# ungroup() %>%
# sample_n(27) %>%
# mutate(
# added_n = cumsum(n)
# )
# total_no2 <- df_trans_card_no_sub2$added_n[27]
#
# df_trans_card_no_sub2 <- df_trans_card_no_sub2[,1]
# df_trans_card_no2 <- left_join(df_trans_card_no_sub2, df_trans_card_no2, by = 'account_id')
# df_trans_card_no_sample2 <- df_trans_card_no2 %>% sample_n(total_no2)
#
# #generate sampled subset of clients with gold card
# df_trans_card_gold <- df_trans_card_all %>%
# filter(issued_date > '1997-09-30' & issued_date < '1998-02-01' & card_type == 'gold')
#
# df_trans_card_gold_sub <- df_trans_card_all %>%
# filter(issued_date > '1997-09-30' & issued_date < '1998-02-01' & card_type == 'gold') %>%
# group_by(account_id) %>%
# count(account_id) %>%
# ungroup() %>%
# sample_n(9) %>%
# mutate(
# added_n = cumsum(n)
# )
# total_gold <- df_trans_card_gold_sub$added_n[9]
#
# df_trans_card_gold_sub <- df_trans_card_gold_sub[,1]
# df_trans_card_gold <- left_join(df_trans_card_gold_sub, df_trans_card_gold, by = 'account_id')
# df_trans_card_gold_sample <- df_trans_card_gold %>% sample_n(total_gold)
#
# #generate sampled subset of clients with classic card
# df_trans_card_classic <- df_trans_card_all %>%
# filter(issued_date > '1997-12-31' & issued_date < '1998-02-01' & card_type == 'classic')
#
# df_trans_card_classic_sub <- df_trans_card_all %>%
# filter(issued_date > '1997-12-31' & issued_date < '1998-02-01' & card_type == 'classic') %>%
# group_by(account_id) %>%
# count(account_id) %>%
# ungroup() %>%
# sample_n(9) %>%
# mutate(
# added_n = cumsum(n)
# )
# total_classic <- df_trans_card_classic_sub$added_n[9]
#
# df_trans_card_classic_sub <- df_trans_card_classic_sub[,1]
# df_trans_card_classic <- left_join(df_trans_card_classic_sub, df_trans_card_classic, by = 'account_id')
# df_trans_card_classic_sample <- df_trans_card_classic %>% sample_n(total_classic)
#
# #generate sampled subset of clients with junior card
# df_trans_card_junior <- df_trans_card_all %>%
# filter(issued_date > '1997-10-31' & issued_date < '1998-02-01' & card_type == 'junior')
#
# df_trans_card_junior_sub <- df_trans_card_all %>%
# filter(issued_date > '1997-10-31' & issued_date < '1998-02-01' & card_type == 'junior') %>%
# group_by(account_id) %>%
# count(account_id) %>%
# ungroup() %>%
# sample_n(9) %>%
# mutate(
# added_n = cumsum(n)
# )
# total_junior <- df_trans_card_junior_sub$added_n[9]
#
# df_trans_card_junior_sub <- df_trans_card_junior_sub[,1]
# df_trans_card_junior <- left_join(df_trans_card_junior_sub, df_trans_card_junior, by = 'account_id')
# df_trans_card_junior_sample <- df_trans_card_junior %>% sample_n(total_junior)
#
# #combine subsets clients with no card and clients with card gold, classic and junior
# df_trans_card_all_sample2 <- bind_rows(df_trans_card_gold_sample, df_trans_card_classic_sample,
# df_trans_card_junior_sample, df_trans_card_no_sample2, .id = NULL)# df_trans_card_all_sample2 %>% ggplot(aes(x = trans_date, y = balance, color = card_type)) + geom_point(alpha = 0.1) + geom_smooth() +
# geom_vline(xintercept = ymd('1998-01-01'), color = 'gray37') +
# geom_text(mapping = aes(x = ymd('1998-01-01'), y = 0, label = "1998-01-01"), color = "gray37", hjust = -0.1, vjust = 1)# #analyse the difference between balance of last transaction before got a card and 31.12.1998
# #clients with gold card
# df_trans_card_gold_sample_diff_start <- df_trans_card_gold_sample %>%
# filter(trans_date <= issued_date) %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_start = balance
# )
#
# df_trans_card_gold_sample_diff_start <- df_trans_card_gold_sample_diff_start[!duplicated(df_trans_card_gold_sample_diff_start$account_id,fromLast=TRUE),]
#
# df_trans_card_gold_sample_diff_end <- df_trans_card_gold_sample %>%
# filter(trans_date == '1998-12-31') %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_end = balance
# )
#
# df_trans_card_gold_sample_diff_end <- df_trans_card_gold_sample_diff_end[!duplicated(df_trans_card_gold_sample_diff_end$account_id,fromLast=TRUE),]
#
# df_trans_card_gold_change <- full_join(df_trans_card_gold_sample_diff_start, df_trans_card_gold_sample_diff_end, by = 'account_id')
#
# #clients with classic card
# df_trans_card_classic_sample_diff_start <- df_trans_card_classic_sample %>%
# filter(trans_date <= issued_date) %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_start = balance
# )
#
# df_trans_card_classic_sample_diff_start <- df_trans_card_classic_sample_diff_start[!duplicated(df_trans_card_classic_sample_diff_start$account_id,fromLast=TRUE),]
#
# df_trans_card_classic_sample_diff_end <- df_trans_card_classic_sample %>%
# filter(trans_date == '1998-12-31') %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_end = balance
# )
#
# df_trans_card_classic_sample_diff_end <- df_trans_card_classic_sample_diff_end[!duplicated(df_trans_card_classic_sample_diff_end$account_id,fromLast=TRUE),]
#
# df_trans_card_classic_change <- full_join(df_trans_card_classic_sample_diff_start, df_trans_card_classic_sample_diff_end, by = 'account_id')
#
# #clients with classic card
# df_trans_card_junior_sample_diff_start <- df_trans_card_junior_sample %>%
# filter(trans_date <= issued_date) %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_start = balance
# )
#
# df_trans_card_junior_sample_diff_start <- df_trans_card_junior_sample_diff_start[!duplicated(df_trans_card_junior_sample_diff_start$account_id,fromLast=TRUE),]
#
# df_trans_card_junior_sample_diff_end <- df_trans_card_junior_sample %>%
# filter(trans_date == '1998-12-31') %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_end = balance
# )
#
# df_trans_card_junior_sample_diff_end <- df_trans_card_junior_sample_diff_end[!duplicated(df_trans_card_junior_sample_diff_end$account_id,fromLast=TRUE),]
#
# df_trans_card_junior_change <- full_join(df_trans_card_junior_sample_diff_start, df_trans_card_junior_sample_diff_end, by = 'account_id')
#
# #clients with no card
# df_trans_card_no_sample_diff_start2 <- df_trans_card_no_sample %>%
# filter(trans_date <= '1998-01-01') %>%
# select(account_id, trans_date, balance, card_type, card) %>%
# arrange(account_id, trans_date) %>%
# rename(
# balance_start = balance
# )
#
# df_trans_card_no_sample_diff_start2 <- df_trans_card_no_sample_diff_start2[!duplicated(df_trans_card_no_sample_diff_start2$account_id,fromLast=TRUE),]
#
# #combine subsets of clients with no card
# df_trans_card_no_change2 <- full_join(df_trans_card_no_sample_diff_start2, df_trans_card_no_sample_diff_end, by = 'account_id')
#
# #combine subsets clients with no card and clients with card
# df_trans_card_change_all2 <- bind_rows(df_trans_card_gold_change, df_trans_card_classic_change, df_trans_card_junior_change, df_trans_card_no_change, .id = NULL)
# df_trans_card_change_all2 <- df_trans_card_change_all2 %>%
# select(-card_type.y, -card.y) %>%
# rename(
# card_type = card_type.x,
# card = card.x,
# trans_date_start = trans_date.x,
# trans_date_end = trans_date.y
# ) %>%
# mutate(
# diff_end_start = balance_end / balance_start,
# change = case_when(
# diff_end_start <= 0.9 ~ 'negative',
# diff_end_start <= 1.1 ~ 'same',
# diff_end_start <= 1.5 ~ '1.5',
# diff_end_start <= 2 ~ 'doubled',
# TRUE ~ 'more'
# )
# )
#
# df_trans_card_change_all2$change <-
# ordered(df_trans_card_change_all2$change, levels = c('negative', 'same', '1.5', 'doubled', 'more'))
#
# #plot
# df_trans_card_change_all2 %>% ggplot(aes(x = change, fill = card_type)) + geom_bar()
# df_trans_card_change_all2 %>% ggplot(aes(x = change, fill = card_type)) + geom_bar() + facet_wrap(~ card_type)# df_trans_loan_all_diff <- df_trans_loan_all %>%
# mutate(
# trans_year = year(trans_date),
# trans_week = week(trans_date),
# month_diff = floor(interval(loan_date, trans_date) / months(1)),
# duration = as.numeric(duration)
# )
#
# df_help_loan3 <- df_trans_loan_all_diff %>%
# select(account_id, loan, loan_status, loan_date, payments, duration, trans_year, trans_week, trans_date, balance, month_diff) %>%
# mutate(
# balance = ifelse((month_diff > 0 & month_diff < duration), (balance - (month_diff * payments)), balance)
# )
#
# df_help_loan4 <- df_help_loan3 %>%
# group_by(loan, loan_status, account_id, trans_year, trans_week) %>%
# arrange(trans_date) %>%
# summarise_all(last) %>%
# ungroup() %>%
# group_by(loan, loan_status, trans_year, trans_week) %>%
# summarise(
# avg_loanstatus_balance = mean(balance),
# med_loanstatus_balance = median(balance),
# loanstatus_last_date = max(trans_date)
# ) %>%
# ungroup()
#
# df_trans_loan_all_diff <- left_join(df_trans_loan_all_diff, df_help_loan4, by = c("loan_status", "trans_year", "trans_week"))# cl <- client %>%
# group_by(district_id) %>%
# summarise(
# avg_age = mean(age),
# med_age = median(age)
# )
#
# df_district_cl <- left_join(district, cl, by = 'district_id')
#
# df_district_cl %>%
# arrange(desc(inhabitants)) %>%
# ggplot(aes(x=ratio_urban_inhabitants, y=med_age, size=inhabitants, fill=region)) +
# geom_point(alpha=0.5, shape=21, color="black") +
# scale_size(range = c(.1, 50), name="inhabitants") +
# scale_fill_viridis(discrete=TRUE, guide=FALSE, option="A") +
# theme_ipsum() +
# labs(title = 'Numbers of transition types divided by operation',
# subtitle = paste0("Anzahl Observationen = ", nrow(client)),
# x = 'ratio_urban_inhabitants',
# y = 'med_age'
# )